Открывать книги в папке и вложенных папках и обновлять каждую

Question

Я запускаю следующий VBA в Ecel, чтобы открыть папку, а затем обновить все листы 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 и добавить ссылку на модель хоста объекта Windows Script в Tools-> References. Затем попробуйте код ниже.

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