Hallo liebe Experten,

ich bin Änfänger und suche eine Lösung die aus einer veränderlichen Anzahl Unterordner alle enthaltenen Excel Dateien kopiert und in ein anderes Verzeichnis einfügt (besser wäre noch er könnte die Dateien einfach öffnen und Tabelle 1 und 2 aus jedem einzelnen Tabellenblatt drucken, das mache ich im Moment im 2. Schritt.).

 

Den benutzen Code habe ich per Google gesucht und etwas angepasst, leider hat Excel 2010 nicht mehr die Funktion "FileSearch". Zum Thema FileSearch habe ich (gefühlt) unendliche Versuche unternommen, um den Code mit "fs" oder auch einem Klassenmodul zu ersetzen, leider reicht es bei mir wohl nicht:(

 

Es wärte toll, wenn mir jemand helfen könnte...DANKE

 

Hier der Code:

Sub Kopieren_Xl_aus_Unterordner()
 Dim i As Long
 Dim ZielPath As String
 Dim QuellPath As String
 Dim NewPath As String
 Dim SuchStr As String

     QuellPath = "C:\Users\Administrator\Documents\Ablage\Excel\Peter\Zeiterfassung\import\"
     ZielPath = "C:\Users\Administrator\Documents\Ablage\Excel\Peter\Zeiterfassung\aktuell\"
     SuchStr = "*.xl*"
     
     With Application.FileSearch
         .NewSearch
         .LookIn = QuellPath
         .SearchSubFolders = True
         .Filename = SuchStr
         .MatchTextExactly = False
         .Execute
         For i = 1 To .FoundFiles.Count
             NewPath = Left(.FoundFiles(i), Len(.FoundFiles(i)) - Len(Dir(.FoundFiles(i))))
             NewPath = ZielPath & Right(NewPath, Len(NewPath) - Len(QuellPath))
             If CheckDir(NewPath) = False Then
                 MsgBox "Kopieren fehlgeschlagen!"
                 Exit Sub
             Else
                 FileCopy .FoundFiles(i), ZielPath & Right(.FoundFiles(i), Len(.FoundFiles(i)) - Len(QuellPath))
             End If
         Next
     End With
 End Sub

 '**** gepostet von rastrans ****
 Function CheckDir(ByVal Verzeichnis As String) As Boolean
     Dim i As Integer
     Dim strNewVerzeichnis As String
     
     If Right(Verzeichnis, 1) <> "\" Then Verzeichnis = Verzeichnis & "\"
     
     On Error GoTo CheckDIR_Exit
     
     i = InStr(4, Verzeichnis, "\")
     Do While i > 0
         strNewVerzeichnis = Left(Verzeichnis, i)
         If Len(Dir(strNewVerzeichnis, vbDirectory)) = 0 Then MkDir (strNewVerzeichnis)
         i = InStr(i + 1, Verzeichnis, "\")
     Loop

CheckDIR_Exit:
     CheckDir = (Err.Number = 0)
 End Function
 '**************