Also hier jetzt mal eine Version die funktionieren sollte. Sie liest (theoretisch :-) ) alle Ordner / Unterordner aus und liest dann alle txt Dateinen ein. Die werden in einem Array übergeben und dann ausgelesen. Gruß

Dim dateien()
Option Explicit

Sub DateienLesen()
    Call EventsOff
    Dim DateiName As String
    Dim quelle As String
    Dim i As Long
   
    ReDim dateien(0)
    dateien(0) = 0
    
    quelle = "C:\Tmp\test_txt"
    Call txtsuchen(quelle)
    
 
    If dateien(0) = 0 Then
    MsgBox "Keine .txt Dateien gefunden!"
    Else
    'Daten auslesen
    
        For i = 1 To dateien(0)
        DateiName = dateien(i)
        With ActiveSheet.QueryTables.Add(Connection:="TEXT;C:\Tmp\test_txt\" & DateiName, Destination:=Range("C" & ActiveSheet.Cells(Rows.Count, 3).End(xlUp).Row + 2))
            .Name = DateiName
            .FieldNames = True
            .RowNumbers = False
            .FillAdjacentFormulas = False
            .PreserveFormatting = True
            .RefreshOnFileOpen = False
            .RefreshStyle = xlInsertDeleteCells
            .SavePassword = False
            .SaveData = True
            .AdjustColumnWidth = True
            .RefreshPeriod = 0
            .TextFilePromptOnRefresh = False
            .TextFilePlatform = 1252
            .TextFileStartRow = 1
            .TextFileParseType = xlDelimited
            .TextFileTextQualifier = xlTextQualifierDoubleQuote
            .TextFileConsecutiveDelimiter = False
            .TextFileTabDelimiter = True
            .TextFileSemicolonDelimiter = False
            .TextFileCommaDelimiter = False
            .TextFileSpaceDelimiter = False
            .TextFileColumnDataTypes = Array(1)
            .Refresh BackgroundQuery:=False
        End With
        
        Next i
    End If
 
    
    Call EventsOn
End Sub
 
Public Sub EventsOff()
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .Calculation = xlCalculationManual
    End With
End Sub
 
Public Sub EventsOn()
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = xlCalculationAutomatic
    End With
End Sub
Function txtsuchen(quelle As String)
Dim suche
Dim ordner()
Dim i As Long

ReDim ordner(0)
ordner(0) = 0
ChDir (quelle)
'Ordner durchschauen
suche = Dir(quelle & "\*.*", vbDirectory)

Do Until suche = ""
    'Normale Dateien rausfiltern
    If (GetAttr(quelle & "\" & suche) = 16) Then
        'die hier ankommen, sind Ordner, extra speichern
        ordner(0) = ordner(0) + 1
        ReDim Preserve ordner(ordner(0))
        ordner(ordner(0)) = suche
    Else
        If Right(suche, 4) = ".txt" Then
            dateien(0) = dateien(0) + 1
            ReDim Preserve dateien(dateien(0))
            dateien(dateien(0)) = suche
        End If
    End If
        
    suche = Dir()
Loop
'jetzt durch die Ordner gehen
For i = 1 To UBound(ordner)
    If Dir(ordner(i), vbNormal) = "" And Left(ordner(i), 1) <> "." Then
        Call txtsuchen(quelle & "\" & ordner(i))
        ChDir (quelle)
    End If
Next
End Function