サブフォルダ内のすべてのファイルを開く

Question

おはようございます、私は多くのサブフォルダにある各マクロファイルでシートを開いてコピーできるこのコードを書いています。 問題は、これらのファイルがすべてサブフォルダに含まれていることですが、名前はすべて同じです。 このコードに何を追加する必要がありますか？

ありがとうございました！

Application.EnableEvents = False 
Application.ScreenUpdating = False 

Path = ActiveWorkbook.Path 

FileName = Dir(Path & "\*.xlsm", vbNormal) 

Do Until FileName = "" 

    Set Wkb = Workbooks.Open(FileName:=Path & "\" & FileName, UpdateLinks:=3) 
    For Each ws In Wkb.Worksheets 
    Application.EnableEvents = False 
    Application.ScreenUpdating = False 
    wsName = ws.Name 
    If (wsName = "Summary (Output)") Then 
     ws.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count) 
    Exit For 
    End If 
    Next ws 
    Wkb.Close False 
    FileName = Dir() 
Loop 

私はすべての宣言を入れていますが、第二のために小さなウィンドウがポップアップ得るよう

Answer 1

一部の人々は、このアプローチが好きではありません:)がある必要はありません。

これは、すべての.XLSワークブックを開きます - ので、XLS、XLSX、XLSM、XLSBとXLSの他のフレーバー

Public Sub OpenAllWorkbooks() 

    Dim vFiles As Variant 
    Dim vFile As Variant 

    vFiles = EnumerateFiles("<Folder Path including final backslash - e.g. C:\Windows\>", "xls*") 

    For Each vFile In vFiles 
     Workbooks.Open vFile 
    Next vFile 

End Sub 

Public Function EnumerateFiles(sDirectory As String, _ 
      Optional sFileSpec As String = "*", _ 
      Optional InclSubFolders As Boolean = True) As Variant 

    EnumerateFiles = Filter(Split(CreateObject("WScript.Shell").Exec _ 
     ("CMD /C DIR """ & sDirectory & "*." & sFileSpec & """ " & _ 
     IIf(InclSubFolders, "/S ", "") & "/B /A:-D").StdOut.ReadAll, vbCrLf), ".") 

End Function