Grüß Gott an Alle,

hab schon geschätzte 3 std jetzt gegoogelt und dachte da richt ich mich an euch.

Ich habe Folgendes Problem beim Makro schreiben:

Es besteht aus einer Hauptdatei, welches eine Spalte 1 mit Dateinamen (z..b. Table_1.xls, Table_2.xls, ...) untereinander besitzt und rechts daneben eine leere Spalte 2 in die der Inhalt der Datei (Dateiname aus Spalte 1) kopiert werden soll.

Beispiel: In der datei Hauptprogramm.xls steht in A1 Table_1.xls, nun soll das Programm nach der Datei Table_1.xls suchen, diese öffnen, den Wert z.b. aus Zelle A25 (ist in jeder Datei die gleiche Zelle) kopieren und ins Hauptprogramm nach B1 einfügen.

Das klappt bis jetzt bei mir mit folgendem Code:

Option Explicit

Sub Makro1()

'Neues Excel Objekt anlegen
'um die zu betrachtende Exceldatei abzulegen

    Dim objExcel        As New Excel.Application

'Sheet Objekt der jeweiligen Exceldatei anlegen
    Dim objSheet        As Object
    
'Anlegen der Hilfsvariablen
    Dim iRow            As Integer
    Dim strDateipfad    As String
    Dim strPfad         As String
    Dim strDateiname    As String
    
'Pfad in welchem sich die Dateien der zu
'kopierenden Zellen sich befinden auswählen
    
    strPfad = "G:\030_Team\Support-Team\Students\Sprenger\"
    
'Schleife welche den Zelleninhalt aller aufgelisteten
'Dateien in mehrere Zellen des Hauptprogramms schreibt
    
      For iRow = 2 To 11

'Überprüfen, ob in Spalte "Dateiname" ein solcher eingetragen ist.
'Fals nicht, wird die Zeile mit einer Fehleranzeige übersprungen.
'(der Arbeitsvorgang wird fortgesetzt)

        If Cells(iRow, 2) = "" Then
            
            MsgBox "Keinen Dateinamen gefunden, bitte Tabelle ergänzen. Arbeitsvorgang wird nun fortgesetzt. Inhalt fehlt in Zeile: " & iRow
            Cells(iRow, 3) = "X"
        Else
        
        
        strDateiname = Cells(iRow, 2)
        strDateipfad = strPfad & strDateiname
            
'Überprüfen, ob die in der Tabelle angegebene Datei vorhanden ist.
'fals nicht, wird die Zeile mit einer Fehleranzeige übersprungen.
'(der Arbeitsvorgang wird fotzgesetzt)
            
            If Dir(strDateipfad) = "" Then
                MsgBox "Datei nicht gefunden, bitte vergewissern Sie sich ob die Datei " & strDateiname & " im jeweiligen Verzeichnis vorhanden ist. Arbeitsvorgang wird nun fortgesetzt"
                Cells(iRow, 3) = "X"
            Else
                objExcel.Workbooks.Open strDateipfad
                Set objSheet = objExcel.Sheets("Sheet1")
                Cells(iRow, 1) = objSheet.Cells(25, 1)
                Cells(iRow, 3) = "-"
                
            End If
         End If
            
      Next iRow

'Objekte (Mappe+Sheet) löschen
'Speicherdialog aufrufen

    objExcel.EnableEvents = False
    objExcel.DisplayAlerts = False

    objExcel.ActiveWorkbook.Close SaveChanges:=False
    objExcel.Quit

    Set objExcel = Nothing
    Set objSheet = Nothing

    Dim strDateinameNeu As String
    strDateinameNeu = "Tabelle mit Inhalt"
    
    Application.Dialogs(xlDialogSaveAs).Show "G:\030_Team\Support-Team\Students\Sprenger\" & strDateinameNeu

End Sub

So, nun ist meine Frage: Wie kann ich dieses Programm erweitern, dass es mir nicht nur den angegebenen Pfad sondern auch alle Ordner in diesem Pfad nach dem Dateinamen durchsucht?