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

Question

我在 Ecel 中运行以下 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

Answer 2

或者，您可以只使用 CMD 并读取输出，这样可以更快地向下钻取子文件夹。

我已经使用".xl*"作为文件过滤器（我假设你只想要 Excel 文件？）但根据你的需要进行更改：

Sub MM()

Const startFolder As String = "C:\Users\MacroMan\Folders\" '// note trailing '\'
Dim file As Variant, wb As Excel.Workbook

For Each file In Filter(Split(CreateObject("WScript.Shell").Exec("CMD /C DIR """ & startFolder & "*.xl*"" /S /B /A:-D").StdOut.ReadAll, vbCrLf), ".")
    Set wb = Workbooks.Open(file)
    '// Do what you want here with the workbook
    wb.Close SaveChanges:=True '// or false...
    Set wb = Nothing
Next

End Sub