VBA代码未完全循环遍历每个文件夹

Question

所以我的问题已被标记为VBA Loop through folder and subfolders to find specific sheet then Copy and Paste certain data

的可能重复

这确实是我的问题，实际上是一样的。我正在努力的部分是从第一个文件夹到其余文件夹的自动化 我认为与改变相关的代码片段在这里

For Each ChildFolder In FSO.GetFolder(MyFolder).SubFolders
        myFile = Dir(MyFolder & ChildFolder.Name & "\")  'DIR gets the first file of the folder

我不想破坏网站的道德规范。我只是接受了一个答案，并且在工作场所发生变化之后我的代码也很挣扎。

下面的原始问题

我希望你能提供帮助。我有一段代码，它的工作正常。基本上它允许用户点击Excel工作簿上的命令按钮（参见图5）打开一个对话框，允许用户选择一个文件夹，然后一旦选择了该文件夹，代码就会循环通过名为的文件夹的文件夹＆＃34; CustomerExp ＆＃34; 然后复制并粘贴有关此赞＆＃34; CustomerExp ＆＃34; Excel工作表到工作簿中名为rejects的另一个Excel工作表，其中包含命令按钮。 我唯一的问题是它仍然需要用户的一些手动输入。

我面临的问题是：我有一个文件夹 2017 它存储在这里 X：\ Operations \拒绝所有市场参见图1

在 2017 文件夹中，我有更多的文件夹以一年中的几个月命名。见图2

在每个月度文件夹中，我们以Jan为例，将会有更多文件夹，参见图3

将月份文件夹中的每个文件夹保存为excel表，请参阅图4

正如我所说，我的代码确实有效，但用户必须做的是每次都选择一个月份文件夹。因此，用户单击命令按钮导航到Jan文件夹双击Jan文件夹，代码工作。然后用户必须双击Feb文件夹，代码再次工作，然后到3月。

我想要的是用户只需点击文件夹2017，然后代码将通过Jan，其所有文件夹都会找到名为赞＆＃34; CustomerExp ＆＃34的文件; 执行复制和粘贴，然后移至2月，然后移至3月等，无需任何输入或用户双击每个月份文件夹。我正在通过点击2017文件夹来寻找完全自动化。

我的代码如下，可以修改为2017年文件夹提供完全自动化。 一如既往，非常感谢任何和所有的帮助。

我的代码

Sub AllWorkbooks()

    Dim MyFolder As String 'Path collected from the folder picker dialog
    Dim myFile As String 'Filename obtained by DIR function
    Dim wbk As Workbook 'Used to loop through each workbook
    Dim FSO As New FileSystemObject ' Requires "Windows Script Host Object Model" in Tools -> References
    Dim ParentFolder As Object, ChildFolder As Object


    Dim wb As Workbook
    Dim myPath As String

    Dim myExtension As String
    Dim FldrPicker As FileDialog
    Dim lRow As Long
    Dim ws2 As Worksheet
    Dim y As Workbook


    On Error Resume Next
    Application.ScreenUpdating = False

    'Opens the folder picker dialog to allow user selection
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Please select a folder"
        .Show
        .AllowMultiSelect = False

        If .SelectedItems.Count = 0 Then 'If no folder is selected, abort
            MsgBox "You did not select a folder"
            Exit Sub
        End If

        MyFolder = .SelectedItems(1) & "\" 'Assign selected folder to MyFolder
    End With

    myFile = Dir(MyFolder) 'DIR gets the first file of the folder


    Set y = ThisWorkbook
    Set ws2 = y.Sheets("Rejects")

    'Loop through all files in a folder until DIR cannot find anymore
    Do While myFile <> ""

    If myFile Like "*CustomerExp*" Then




        'Opens the file and assigns to the wbk variable for future use
        Set wbk = Workbooks.Open(Filename:=MyFolder & myFile)
        'Replace the line below with the statements you would want your macro to perform
                With wbk.Sheets(1)

            lRow = .Range("A" & .Rows.Count).End(xlUp).Row
            .Range("A1:AA" & lRow).Copy ws2.Range("A" & Rows.Count).End(xlUp)(2)
        End With
        ''Application.Wait (Now + TimeValue("0:00:05"))
        wbk.Close savechanges:=True

        End If
        myFile = Dir 'DIR gets the next file in the folder



    Loop

    For Each ChildFolder In FSO.GetFolder(MyFolder).SubFolders
        myFile = Dir(MyFolder & ChildFolder.Name & "\")  'DIR gets the first file of the folder
        'Loop through all files in a folder until DIR cannot find anymore
        Do While myFile <> ""

        If myFile Like "*CustomerExp*" Then

            'Opens the file and assigns to the wbk variable for future use
            Set wbk = Workbooks.Open(Filename:=MyFolder & ChildFolder.Name & "\" & myFile)
            'Replace the line below with the statements you would want your macro to perform
                            With wbk.Sheets(1)
            lRow = .Range("A" & .Rows.Count).End(xlUp).Row
            .Range("A1:AA" & lRow).Copy ws2.Range("A" & Rows.Count).End(xlUp)(2)
        End With
            ''Application.Wait (Now + TimeValue("0:00:05"))
            wbk.Close savechanges:=True
            End If
            myFile = Dir 'DIR gets the next file in the folder
        Loop
    Next ChildFolder

    Application.ScreenUpdating = True

End Sub

图1

图2

图3

图4

图5