XML Dateien in Excel importieren

intNextOffset = Sheet.ListObjects(counter).ListRows.Count

intNextOffset = Ws.ListObjects(counter).ListRows.Count

Sub XML_Dateien_Einlesen()

    Dim Datei$, Pfad$, DateiMatch$
    Dim AnfZelle As Range, Wb As Workbook, Ws As Worksheet, lo As ListObject, mainLO As ListObject, col As ListRow
    On Error Resume Next
    
    Set Wb = ActiveWorkbook
    Set Ws = Wb.ActiveSheet
    
    'Range vorher löschen bevor wir importieren  
    Ws.Range("A:H").Delete  
    
    Set AnfZelle = Ws.Range("A1") '<== Anfangszelle im aktiven Arbeitsblatt der aktiven Arb.Mappe  
    
    Pfad$ = "D:\_TEST\" '<== Pfad zum Verzeichnis einstellen  
    DateiMatch$ = "TEST*.xml" '<== Datei-Matching, um gewünschte Dateien zu filtern  
    
    Datei$ = Dir(Pfad$ & DateiMatch$, vbNormal)
    
    counter = 1
    Do While Datei$ <> ""  
        Wb.XmlImport URL:=Pfad$ & Datei$, ImportMap:=Nothing, Overwrite:=True, Destination:=AnfZelle
        If counter > 1 Then
            Set lo = Ws.ListObjects(2)
            Set mainLO = Ws.ListObjects(1)
            Set col = mainLO.ListRows.Add
            lo.DataBodyRange.Copy col.Range
            intNextOffset = lo.ListRows.Count
            lo.Delete
        Else
            Set lo = Ws.ListObjects(1)
            intNextOffset = lo.ListRows.Count
        End If
        Set AnfZelle = AnfZelle.Offset(intNextOffset, 0)
        Datei$ = Dir()
        counter = counter + 1
    Loop
End Sub

Dim AnfZelle As Range, TempZelle As Range, fso As Object, Wb As Workbook, Ws As Worksheet, Prefix As String, extension As String, firstImport As Boolean
Sub XML_Dateien_Einlesen()
    Set Wb = ActiveWorkbook
    Set Ws = Wb.ActiveSheet
    'Filesystem Object erstellen  
    Set fso = CreateObject("Scripting.FileSystemObject")  
    
    'Root-Pfad zu den Dateien  
    Pfad = "D:\_TEST"  
    'Prefix der zu importierenden Dateien  
    Prefix = "TEST"  
    'Extension der Dateien  
    extension = "xml"  
    'Import-Bereich löschen damit neu importiert werden kann/ wenn die importierten XML-Dateien mehr Spalten als 8 haben entsprechend anpassen  
    Ws.Range("A:H").Delete  
    'Import-Anfangszelle setzen  
    Set AnfZelle = Ws.Range("A1")  
    ' Temporäre Zelle für den Import von weiteren XML-Dateien  
    Set TempZelle = Ws.Range("Z1")  
    firstImport = True
    'Ordner mit Funktion rekursiv durchsuchen  
    parseFolder fso.GetFolder(Pfad), True
    'Garbage collection  
    Set fso = Nothing
    Set Wb = Nothing
    Set Ws = Nothing
End Sub

'Diese Funktion durchläuft die Unterordner rekursiv  
Function parseFolder(strFldr, boolRecursion)
    For Each f In strFldr.Files
        'Wenn Datei die Extension 'xml' hat und mit 'TEST' beginnt dann...  
        If LCase(extension) = LCase(fso.GetExtensionName(f.Path)) And Left(fso.GetFilename(f.Path), 4) = Prefix Then
            If Not firstImport Then
                ' Importiere weitere XML-Dateien  
                Wb.XmlImport URL:=f.Path, ImportMap:=Nothing, Overwrite:=True, Destination:=TempZelle
                'ListObject an der temporär importierten Zelle  
                Set lo = Ws.ListObjects(2)
                'Haupt ListObject in das wir den Inhalt des anderen ListObject importieren werden  
                Set mainLO = Ws.ListObjects(1)
                'Eine neue Reihe im Haupt ListObject hinzufügen  
                Set col = mainLO.ListRows.Add
                'Inhalt des temporären ListObject in das Haupt ListObject kopieren  
                lo.DataBodyRange.Copy col.Range
                'temporäres ListObject wieder löschen  
                lo.Delete
            Else
                'Importiere erste XML-Datei  
                Wb.XmlImport URL:=f.Path, ImportMap:=Nothing, Overwrite:=True, Destination:=AnfZelle
                ' Die erste XML-Datei ist importiert also setze firstImport = False  
                firstImport = False
            End If
        End If
    Next
    
    'Funktion rekursiv für alle Unterordner ausführen  
    If boolRecursion Then
        For Each subFolder In strFldr.SubFolders
            parseFolder subFolder, True
        Next
    End If
End Function