Alle XML Dateien eines Ordners in Excel per VBA einlesen

Guten Morgen,

ich möchte bestimmte XML Dateien eines Ordner in eine Mappe hintereinander einlesen.

Eine Datei bekomme ich ohne Probleme hin, nur die Schleife leider nicht

     Sub import()
     Dim strTargetFile As String
     Application.DisplayAlerts = False
     strTargetFile = "C:\Users\thomas\Desktop\xml2\Neuer Ordner\HID1_PROD*.xml"  
     Workbooks.OpenXML Filename:=strTargetFile, LoadOption:=xlXmlLoadImportToList
     Application.DisplayAlerts = True

     End Sub

Bitte markiere auch die Kommentare, die zur Lösung des Beitrags beigetragen haben

Content-ID: 289747

Url: https://administrator.de/contentid/289747

Ausgedruckt am: 15.11.2024 um 05:11 Uhr

5 Kommentare

Neuester Kommentar

Hallo

In etwa so (ungetestet)

Sub Import
      Dim strPath As String
      Dim strTargetFile As String
      Application.DisplayAlerts = False
      strPath = "C:\Users\thomas\Desktop\xml2\Neuer Ordner\"  
      strTargetFile = Dir(strPath & "*.xml")  
      Do Until strTargetFile = ""  
      Workbooks.OpenXML Filename:=strPath & strTargetFile, LoadOption:=xlXmlLoadImportToList
      Application.DisplayAlerts = True
      strTargetFile = Dir
      Loop
End Sub

Gruss Urs

Dank für den Ansatz,,
klappt bestens.
hab nur übersehen, dass er jedes mal eine neue Mappe aufmacht.
Wo kann ich Excel sagen., dass er in die bestehende Mappe schreiben soll?

Grüße aus München

Hallo

Freut mich, dass es soweit klappt.
Soll er jede XML Datei in eine separate Tabelle schreiben??

Gruss

Nein,
es sollen alle XML Dateien hintereinander eingefügt werden. so das am schluss eine grosse Tabelle angelegt ist.

Moin Thomas,
hiermit geht das z.B. wie gewünscht...

es sollen alle XML Dateien hintereinander eingefügt werden. so das am schluss eine grosse Tabelle angelegt ist.

Sub ImportXML()
    Const XMLPATH ="C:\Users\thomas\Desktop\xml2\Neuer Ordner"   
    Dim f As Object, c As Object
    Set fso = CreateObject("Scripting.Filesystemobject")  
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    With Sheets(1)
        For Each f In fso.GetFolder(XMLPATH).Files
            If LCase(fso.GetExtensionName(f.Name)) = "xml" Then  
                ActiveWorkbook.XmlImport URL:=f.Path, ImportMap:=Nothing, Overwrite:=True, Destination:=.Range("A" & .UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1)  
                ActiveWorkbook.Connections(ActiveWorkbook.Connections.Count).Delete
            End If
        Next
    End With
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    MsgBox "Importvorgang beendet!", vbInformation  
    Set fso = Nothing
End Sub

Gruß jodel32