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

时间:2016-11-23 10:05:03

标签: vba excel-vba macros excel

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

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,但每次运行时我都会收到该行中的错误。有什么建议请问如何写得正确?非常感谢你。

2 个答案:

答案 0 :(得分: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

答案 1 :(得分:1)

您可以使用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..