Öffnen Sie alle Dateien in Unterordnern

Question

Guten Morgen, ich schreibe diesen Code, mit dem ich ein Blatt in jeder Makrodatei, die ich in vielen Unterordnern habe, öffnen und kopieren kann. Das Problem ist, dass ich alle diese Dateien in Unterordnern in einem Ordner haben, aber sie haben alle unterschiedliche Namen. Was soll ich zu diesem Code hinzufügen?

Vielen Dank!

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 

Ich habe nicht die ganze Erklärung setzen, aber es gibt :)

Answer 1

Manche Leute mögen es nicht, diesen Ansatz als Sie ein kleines Fenster für eine zweite Pop-up zu bekommen.

Dadurch wird alle .xls Arbeitsmappe öffnen - so xls, xlsx, xlsm, xlsb und anderen Geschmack von 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