循环遍历所有文件夹及其所有子文件夹VBA

我知道这个问题之前被问过很多次，我已经检查了之前的建议，但我无法让我的代码运行。

所以，我有一个名为“Report”的文件夹，其中也包含多个文件夹。这些文件夹包含 .xlsx 和 .zip 文件。

每个文件还包含一个名为“2016”的文件夹，其下有 12 个文件夹“January”、“February”、...、“December”。

Here is an example of one Subfolder

我想要做的是，循环遍历所有这些子文件夹，并根据创建日期将 .xlsx 和 .zip 文件移动到每月文件夹。

例如，11 月创建的位置中的所有 .xlsx 和 .zip 将被移动到同一位置的“2016”中的“11 月”文件夹。

我创建了这个宏，但它很耗时，因为每次我都需要更改每个子文件夹的路径并为每个子文件夹运行它。

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

我想自动化我的宏，以便它可以在所有子文件夹上工作，而不是一一地更改路径。 请问有什么建议吗？非常感谢。

与@luke_t和@Lowpar不同，我不认为递归循环，查看所有子文件夹和文件是正确的答案，因为当你到达底部文件夹时（即C:\Report\Shipment\2016\May\）您将获取并移动已经位于正确位置的文件。

由于文件夹的结构是固定的，因此您可以循环遍历每个文件夹.xlsx and .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 的方法会更合适。