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

Question

我知道这个问题之前已经被问了很多次，我已经查看了之前的建议，但是我无法使我的代码运行起来。

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

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

以下是一个子文件夹的示例 我想做的是遍历所有这些子文件夹，并根据创建日期将.xlsx和.zip文件移动到月度文件夹中。

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

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

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

我希望自动化我的宏，使其能够在所有子文件夹中运行，而不是一个接一个地更改路径。

请问有什么建议吗？非常感谢。

- JuniorDev

---

这将递归地浏览文件夹。请参考：http://www.mrexcel.com/forum/excel-questions/643288-excel-2010-visual-basic-applications-replacement-application-filesearch.html - Lowpar

Answer 1

不像@luke_t和@Lowpar那样，我认为递归循环查找所有子文件夹和文件并不是正确的答案，因为当你到达最底层文件夹（即C:\Report\Shipment\2016\May\）时，你将获得并移动已经在正确位置的文件。

由于你有固定的文件夹结构，你只需要遍历主文件夹（C:\Report\）中每个子文件夹中的每个.xlsx和.zip文件。

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提出的方法会更加合适。

- Limak

Answer 2

我建议使用递归函数来到达文件夹结构的最底层。

下面是一个函数，它将遍历从所提供的文件夹开始的所有子文件夹。

一旦该函数到达文件夹结构的最底层，它将开始遍历每个文件，并在需要移动文件时执行此任务的代码（在下面的示例中我放置了一个注释）。

您需要启用Microsoft脚本运行时引用（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

- luke_t