vba - 打开文件夹和子文件夹中的工作簿并更新每个

Question

我在 Excel 中运行以下 VBA 以打开一个文件夹，然后更新此文件夹中的所有 Excel 工作表。但是我希望它也包括所有子文件夹。

 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

    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

    'Loop through all files in a folder until DIR cannot find anymore
    Do While MyFile <> “”
       '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
       ActiveWorkbook.RefreshAll
       Application.Wait (Now + TimeValue("0:00:05"))
       wbk.Close savechanges:=True
       MyFile = Dir 'DIR gets the next file in the folder
    Loop

    Application.ScreenUpdating = True

    End Sub

Answer 1

好的，您需要使用 FileSystemObject 并在 Tools->References 中添加对 Windows Script Host Object Model 的引用。然后试试下面的代码。

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

    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

    'Loop through all files in a folder until DIR cannot find anymore
    Do While MyFile <> ""
        '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
        ActiveWorkbook.RefreshAll
        Application.Wait (Now + TimeValue("0:00:05"))
        wbk.Close savechanges:=True
        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 <> ""
            '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
            ActiveWorkbook.RefreshAll
            Application.Wait (Now + TimeValue("0:00:05"))
            wbk.Close savechanges:=True
            MyFile = Dir 'DIR gets the next file in the folder
        Loop
    Next ChildFolder

    Application.ScreenUpdating = True

End Sub