Loop Through All Folders and All its Subfolders VBA
<p>i know the question was asked many times before, i have checked the previous suggestions but i couldn't make my code run. </p>

<p>So, i have a folder called "Report" which contains multiple folders as well. These folders contains .xlsx and .zip files. </p>

<p>Each file contains also a folder called "2016" and under it 12 folders "January", "February",..., "December". </p>

<p>Here is an example of one Subfolder
<a href="https://i.stack.imgur.com/Z0QDA.png" rel="nofollow noreferrer"><img src="https://i.stack.imgur.com/Z0QDA.png" alt="enter image description here"></a></p>

<p>What i want to do is, to loop through all these subFolders and move the .xlsx and .zip files to the monthly folder based on createdDate.</p>

<p>For example, all .xlsx and .zip in a location created in November they will be moved to the folder "November" in "2016" in the same location.</p>

<p>I created this macro but it's time consuming because everytime i need to change the path of each subfloder and run it for each subFolder.</p>

<pre><code>Sub Move_Files_To_Folder()

Dim Fso As Object
Dim FromPath As String
Dim ToPath As String
Dim FileInFromFolder As Object

'Change Path
FromPath = "C:\Report\Shipment\"
ToPath = "C:\Report\Shipment\2016\"

Set Fso = CreateObject("scripting.filesystemobject")

For Each FileInFromFolder In Fso.GetFolder(FromPath).Files

'Change month and year
If (Month(FileInFromFolder.DateCreated)) = 11 And (year(FileInFromFolder.DateCreated)) = 2016 _
And (InStr(1, FileInFromFolder.name, ".xlsx") Or InStr(1, FileInFromFolder.name, ".zip")) Then
FileInFromFolder.Move (ToPath &amp; MonthName(Month(FileInFromFolder.DateCreated)) &amp; "\")
End If

Next FileInFromFolder

End Sub
</code></pre>

<p>I want to automate my macro so that it will work on all the subfolders Not one by one and changing the path everytime.
Any suggestions please ? Thank you very much. </p>