循环遍历文件夹及其子文件夹的特定列表VBA宏

Question

我已经创建了一个解决方案来循环遍历路径中的所有文件夹及其子文件夹，然后根据条件移动文件。

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:\Reports\" 
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 

它工作正常，但我想调整我的宏以循环通过我的路径和所有他们的子文件夹下的特定文件夹。

因此，而不是For Each objSubFolder In objFolder.subfolders我想创建一个数组列表，其中包含我的路径下的文件夹的名称来循环。

像这样的事情

FoldersName = Array("Shipment", "Backlog", "Released", "Unreleased") 
For Each objSubFolder In objFolder.FoldersName 
For Each FileInFolder In objSubFolder.Files 
'rest of my code 
Next FileInFolder 
Next objSubFolder 

所以，作为一个总结，通过我的路径下的所有文件夹和子文件夹我的解决方案循环，我想将它调整到我的路径下的文件夹及其所有子文件夹的列表。

我试图创建此array并将其添加到For Each但每次我运行我得到该行中的错误。任何建议请如何正确写入？非常感谢你。

Answer 1

只需遍历数组，每次都为objFolder创建一个新的路径。 这应该工作：

Sub Move_Files_To_Folder() 

Dim Fso As Object, objFolder As Object, objSubFolder As Object 
Dim FromPath As String 
Dim FileInFolder As Object, i as integer 

FoldersName = Array("Shipment", "Backlog", "Released", "Unreleased") 
FromPath = "C:\Reports\" 
Set Fso = CreateObject("Scripting.filesystemobject") 

for i = 1 to ubound(FoldersName) 

    Set objFolder = Fso.GetFolder(FromPath & FoldersName(i) & "\") 

    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 
next 

End Sub 

Answer 2

您可以使用Dictionary对象（脚本库），并期待它为每个子文件夹名称

Dim dic As Object 
Set dic = CreateObject("Scripting.dictionary") 
For Each word In Array("Shipment", "Backlog", "Released", "Unreleased") 
    dic.Add word, word 
Next 

For Each objSubFolder In objFolder.SubFolders 
    If dic.contains(objSubFolder.Name) Then 
    'etc etc..