Loop Through All Folders and all its VBA subfolders

Question

I know that the question was asked many times before, I checked the previous sentences, but I could not run my code.

So, I have a folder called "Report", which also contains several folders. These folders contain the .xlsx and .zip files.

Each file also contains a folder called "2016" and below it are 12 folders "January", "February", ..., "December".

Here is an example of one subfolder

What I want to do is iterate over all of these subfolders and move the .xlsx and .zip files to a monthly folder based on createdDate.

For example, all .xlsx and .zip in a location created in November will be moved to the November folder in 2016 in the same location.

, , .

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 & MonthName(Month(FileInFromFolder.DateCreated)) & "\")
End If

Next FileInFromFolder

End Sub

, . , ? .

Answer 1

@luke_t @Lowpar, , , , , , (.. C:\Report\Shipment\2016\May\), .

, , .xlsx .zip (C:\Report\).

Sub Move_Files_To_Folder()

Dim Fso As Object, objFolder As Object, objSubFolder As Object
Dim FromPath As String
Dim FileInFolder As Object

FromPath = "C:\Report\"
Set Fso = CreateObject("Scripting.filesystemobject")
Set objFolder = Fso.GetFolder(FromPath)

For Each objSubFolder In objFolder.subfolders
    For Each FileInFolder In objSubFolder.Files

        If InStr(1, FileInFolder.Name, ".xlsx") Or InStr(1, FileInFolder.Name, ".zip") Then
            FileInFolder.Move (objSubFolder.path & "\2016\" & MonthName(Month(FileInFolder.DateCreated)) & "\")
        End If

    Next FileInFolder
Next objSubFolder

End Sub

, , , @luke_t, .

Answer 2

, .

.

, , ( , , ).

Runtime Microsoft Scripting Runtime (VBE → → )

Option Explicit

Public Sub move_documents()

    Dim fSystem As Scripting.FileSystemObject
    Dim fp As String

    Set fSystem = New Scripting.FileSystemObject
    fp = "C:\xyz" ' Enter your folder start location

    find_folders fSystem.GetFolder(fp)

End Sub

Private Function find_folders(ByVal fldr As Folder)

    Dim sf As Folder

    For Each sf In fldr.SubFolders
        find_folders sf, ws
    Next

    ' Enter function or code to move each file in a folder here.

End Function