Top-Themen

Aktuelle Themen (A bis Z)

Administrator.de FeedbackApache ServerAppleAssemblerAudioAusbildungAuslandBackupBasicBatch & ShellBenchmarksBibliotheken & ToolkitsBlogsCloud-DiensteClusterCMSCPU, RAM, MainboardsCSSC und C++DatenbankenDatenschutzDebianDigitiales FernsehenDNSDrucker und ScannerDSL, VDSLE-BooksE-BusinessE-MailEntwicklungErkennung und -AbwehrExchange ServerFestplatten, SSD, RaidFirewallFlatratesGoogle AndroidGrafikGrafikkarten & MonitoreGroupwareHardwareHosting & HousingHTMLHumor (lol)Hyper-VIconsIDE & EditorenInformationsdiensteInstallationInstant MessagingInternetInternet DomäneniOSISDN & AnaloganschlüsseiTunesJavaJavaScriptKiXtartKVMLAN, WAN, WirelessLinuxLinux DesktopLinux NetzwerkLinux ToolsLinux UserverwaltungLizenzierungMac OS XMicrosoftMicrosoft OfficeMikroTik RouterOSMonitoringMultimediaMultimedia & ZubehörNetzwerkeNetzwerkgrundlagenNetzwerkmanagementNetzwerkprotokolleNotebook & ZubehörNovell NetwareOff TopicOpenOffice, LibreOfficeOutlook & MailPapierkorbPascal und DelphiPeripheriegerätePerlPHPPythonRechtliche FragenRedHat, CentOS, FedoraRouter & RoutingSambaSAN, NAS, DASSchriftartenSchulung & TrainingSEOServerServer-HardwareSicherheitSicherheits-ToolsSicherheitsgrundlagenSolarisSonstige SystemeSoziale NetzwerkeSpeicherkartenStudentenjobs & PraktikumSuche ProjektpartnerSuseSwitche und HubsTipps & TricksTK-Netze & GeräteUbuntuUMTS, EDGE & GPRSUtilitiesVB for ApplicationsVerschlüsselung & ZertifikateVideo & StreamingViren und TrojanerVirtualisierungVisual StudioVmwareVoice over IPWebbrowserWebentwicklungWeiterbildungWindows 7Windows 8Windows 10Windows InstallationWindows MobileWindows NetzwerkWindows ServerWindows SystemdateienWindows ToolsWindows UpdateWindows UserverwaltungWindows VistaWindows XPXenserverXMLZusammenarbeit

gelöst XML Dateien in Excel importieren

Mitglied: a.grothe

a.grothe (Level 1) - Jetzt verbinden

26.11.2013 um 12:49 Uhr, 10204 Aufrufe, 12 Kommentare, 3 Danke

Hallo zusammen,

ich möchte zwei XML Dateien (bzw. mehrere) nach Excel importieren.

Mit folgendder Sache klappt es auch ansatzweise.

Im Verzeichnis D:\_TEST\

liegen zwei Dateien TEST.xml und TEST1.xml, leider liest er mir nach Excel immer nur die erste Datei ein die zweite nimmt er nicht.

Wo liegt mein Fehler die Struktur der beiden Dokumente ist gleich?

Sub XML_Dateien_Einlesen()
'
Dim Datei$, Pfad$, DateiMatch$
Dim AnfZelle As Range, Wb As Workbook, Ws As Worksheet
On Error Resume Next

Set Wb = ActiveWorkbook
Set Ws = Wb.ActiveSheet

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)

Do Until Len(Datei$) = 0
Wb.XmlImport URL:=Pfad$ & Datei$, ImportMap:=Nothing, Overwrite:=True, Destination:=AnfZelle
Datei$ = Dir()
Set AnfZelle = AnfZelle.Offset(1)
Loop

End Sub
Mitglied: colinardo
26.11.2013, aktualisiert 27.11.2013
Hallo a.grothe,
es funktioniert nur der erste Import, weil du beim zweiten Durchlauf der Schleife als "Destination" einen Bereich angibst der nach dem ersten Import bereits der ersten Datenquelle gehört, bzw. in dem bereits die Daten des ersten Imports stehen. Da ein XML-Import immer mit einer Zuordnung zur XML-Datei durchgeführt wird darf kein anderer Import diesen Bereich überschreiben. Du musst also nach dem ersten Import die nächste leere Zelle ermitteln und dann dort hinein importieren.
01.
Do Until Len(Datei$) = 0
02.
  Wb.XmlImport URL:=Pfad$ & Datei$, ImportMap:=Nothing, Overwrite:=True, Destination:=AnfZelle
03.
  Datei$ = Dir()
04.
  Set anfZelle = anfZelle.End(xlDown).Offset(1, 0)
05.
Loop
Beachte dabei das dann in allen Zeilen des Imports in Spalte A ein Wert stehen muss. Wenn du das nicht sicherstellen kannst, musst du die nächste freie Zelle es über die Eigenschaft "ListRows" des ListObjects ermitteln wie hier:
01.
  counter = 1
02.
  Do Until Len(Datei$) = 0
03.
    Wb.XmlImport URL:=Pfad$ & Datei$, ImportMap:=Nothing, Overwrite:=True, Destination:=AnfZelle
04.
    Datei$ = Dir()
05.
    intNextOffset = Ws.ListObjects(counter).ListRows.Count
06.
    Set AnfZelle = AnfZelle.Offset(intNextOffset, 0)
07.
    counter = counter + 1
08.
  Loop
Noch als Tipps zur Hilfe während der Entwicklungsphase:
Damit du solche Fehler in Zukunft gemeldet bekommst musst du das On Error Resume Next auskommentieren. Außerdem kannst du dann im VBA-Editor mit Breakpoints und dem Einzelschritt-Modus, Zeile für Zeile den Code ausführen, so siehst du schneller wo es hakt...

Grüße Uwe
Bitte warten ..
Mitglied: a.grothe
27.11.2013 um 12:00 Uhr
Hallo Uwe, danke für die Hilfe: Aber er nimmt immer noch nur die erste Datei obwohl eine TEST und eine TEST1.xml im Verzeichnis liegen.

Sub XML_Dateien_Einlesen()
'
Dim Datei$, Pfad$, DateiMatch$
Dim AnfZelle As Range, Wb As Workbook, Ws As Worksheet
On Error Resume Next

Set Wb = ActiveWorkbook
Set Ws = Wb.ActiveSheet

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 Until Len(Datei$) = 0
Wb.XmlImport URL:=Pfad$ & Datei$, ImportMap:=Nothing, Overwrite:=True, Destination:=AnfZelle
Datei$ = Dir()
intNextOffset = Sheet.ListObjects(counter).ListRows.Count
Set AnfZeile = AnfZeile.Offset(intNextOffset, 0)
counter = counter + 1
Loop
End Sub
Bitte warten ..
Mitglied: colinardo
27.11.2013, aktualisiert um 12:05 Uhr
sorry, hatte eine Variable nicht an deine verwendete angepasst:
hier das "Sheet" durch dein "Ws" ersetzen:
intNextOffset = Sheet.ListObjects(counter).ListRows.Count
das es so aussieht:
intNextOffset = Ws.ListObjects(counter).ListRows.Count
und vergessen nicht, wenn du die Sachen erneut importieren willst musst du erst den gesamten Range löschen
und mach das On Error Reume Next mal raus damit du eventuelle Fehler siehst !!
Grüße Uwe
Bitte warten ..
Mitglied: a.grothe
27.11.2013 um 12:23 Uhr
Danke klappt wunderbar. Mit dem Error war auch ein guter Tipp, da AnfZeile noch in AnfZelle geändert werden musste. Kann man irgendwie die Spaltenüberschriften ausblenden beim import? bzw. bei der zweiten Datei weglassen? Brauche das nur in der ersten Zeile (Kennzeichen Id Tor CreateTime SendTime CloseTime ClosedBy SendErfolg).

Kennzeichen Id Tor CreateTime SendTime CloseTime ClosedBy SendErfolg
BZ-XX 191 1 H2/ 1 2013-11-08T11:26:38.747+01:00 2013-11-08T11:30:40.531+01:00 2013-11-08T12:10:42.016+01:00 user WAHR
Kennzeichen Id Tor CreateTime SendTime CloseTime ClosedBy SendErfolg
AC-XX 4427 1 H2/ 5 2013-11-07T09:10:15.435278+01:00 2013-11-07T09:10:52.074278+01:00 2013-11-07T12:04:33.289+01:00 user WAHR
Bitte warten ..
Mitglied: colinardo
27.11.2013, aktualisiert um 13:30 Uhr
Das geht nur über einen Umweg:
01.
Sub XML_Dateien_Einlesen()
02.

03.
    Dim Datei$, Pfad$, DateiMatch$
04.
    Dim AnfZelle As Range, Wb As Workbook, Ws As Worksheet, lo As ListObject, mainLO As ListObject, col As ListRow
05.
    On Error Resume Next
06.
    
07.
    Set Wb = ActiveWorkbook
08.
    Set Ws = Wb.ActiveSheet
09.
    
10.
    'Range vorher löschen bevor wir importieren
11.
    Ws.Range("A:H").Delete
12.
    
13.
    Set AnfZelle = Ws.Range("A1") '<== Anfangszelle im aktiven Arbeitsblatt der aktiven Arb.Mappe
14.
    
15.
    Pfad$ = "D:\_TEST\" '<== Pfad zum Verzeichnis einstellen
16.
    DateiMatch$ = "TEST*.xml" '<== Datei-Matching, um gewünschte Dateien zu filtern
17.
    
18.
    Datei$ = Dir(Pfad$ & DateiMatch$, vbNormal)
19.
    
20.
    counter = 1
21.
    Do While Datei$ <> ""
22.
        Wb.XmlImport URL:=Pfad$ & Datei$, ImportMap:=Nothing, Overwrite:=True, Destination:=AnfZelle
23.
        If counter > 1 Then
24.
            Set lo = Ws.ListObjects(2)
25.
            Set mainLO = Ws.ListObjects(1)
26.
            Set col = mainLO.ListRows.Add
27.
            lo.DataBodyRange.Copy col.Range
28.
            intNextOffset = lo.ListRows.Count
29.
            lo.Delete
30.
        Else
31.
            Set lo = Ws.ListObjects(1)
32.
            intNextOffset = lo.ListRows.Count
33.
        End If
34.
        Set AnfZelle = AnfZelle.Offset(intNextOffset, 0)
35.
        Datei$ = Dir()
36.
        counter = counter + 1
37.
    Loop
38.
End Sub
Grüße Uwe
Bitte warten ..
Mitglied: a.grothe
27.11.2013 um 13:42 Uhr
Hallo Uwe,

vielen Dank. Kannst du ein Buch (eBook) empfehlen um das besser zu verstehen?
Bitte warten ..
Mitglied: colinardo
27.11.2013, aktualisiert um 13:50 Uhr
Das Script macht folgendes:
Es importiert die erste CSV-Datei normal, beim Import der zweiten wird eine neue Zeile in der ersten Tabelle erstellt und der Inhalt der zweiten Tabelle ans Ende der ersten Tabelle kopiert, danach wird das ListObject in dem die zweite CSV-Datei importiert wurde wieder gelöscht, usw. Übrig bleibt nur noch eine Tabelle mit dem kompletten Inhalt aller XML-Dateien.
Grüße Uwe
Bitte warten ..
Mitglied: a.grothe
28.11.2013 um 07:54 Uhr
Danke. Es klappt nun wunderbar. Kann man den Pfad noch so anpassen, das er auch Unterverzeichnisse durchsucht?
Bitte warten ..
Mitglied: colinardo
28.11.2013 um 10:59 Uhr
Zitat von a.grothe:
Danke. Es klappt nun wunderbar. Kann man den Pfad noch so anpassen, das er auch Unterverzeichnisse durchsucht?
Kann man, das erfordert aber einen radikalen Umbau. Ich habe die Zeilen mal kommentiert, damit du es hoffentlich besser verstehst:
01.
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
02.
Sub XML_Dateien_Einlesen()
03.
    Set Wb = ActiveWorkbook
04.
    Set Ws = Wb.ActiveSheet
05.
    'Filesystem Object erstellen
06.
    Set fso = CreateObject("Scripting.FileSystemObject")
07.
    
08.
    'Root-Pfad zu den Dateien
09.
    Pfad = "D:\_TEST"
10.
    'Prefix der zu importierenden Dateien
11.
    Prefix = "TEST"
12.
    'Extension der Dateien
13.
    extension = "xml"
14.
    'Import-Bereich löschen damit neu importiert werden kann/ wenn die importierten XML-Dateien mehr Spalten als 8 haben entsprechend anpassen
15.
    Ws.Range("A:H").Delete
16.
    'Import-Anfangszelle setzen
17.
    Set AnfZelle = Ws.Range("A1")
18.
    ' Temporäre Zelle für den Import von weiteren XML-Dateien
19.
    Set TempZelle = Ws.Range("Z1")
20.
    firstImport = True
21.
    'Ordner mit Funktion rekursiv durchsuchen
22.
    parseFolder fso.GetFolder(Pfad), True
23.
    'Garbage collection
24.
    Set fso = Nothing
25.
    Set Wb = Nothing
26.
    Set Ws = Nothing
27.
End Sub
28.

29.
'Diese Funktion durchläuft die Unterordner rekursiv
30.
Function parseFolder(strFldr, boolRecursion)
31.
    For Each f In strFldr.Files
32.
        'Wenn Datei die Extension 'xml' hat und mit 'TEST' beginnt dann...
33.
        If LCase(extension) = LCase(fso.GetExtensionName(f.Path)) And Left(fso.GetFilename(f.Path), 4) = Prefix Then
34.
            If Not firstImport Then
35.
                ' Importiere weitere XML-Dateien
36.
                Wb.XmlImport URL:=f.Path, ImportMap:=Nothing, Overwrite:=True, Destination:=TempZelle
37.
                'ListObject an der temporär importierten Zelle
38.
                Set lo = Ws.ListObjects(2)
39.
                'Haupt ListObject in das wir den Inhalt des anderen ListObject importieren werden
40.
                Set mainLO = Ws.ListObjects(1)
41.
                'Eine neue Reihe im Haupt ListObject hinzufügen
42.
                Set col = mainLO.ListRows.Add
43.
                'Inhalt des temporären ListObject in das Haupt ListObject kopieren
44.
                lo.DataBodyRange.Copy col.Range
45.
                'temporäres ListObject wieder löschen
46.
                lo.Delete
47.
            Else
48.
                'Importiere erste XML-Datei
49.
                Wb.XmlImport URL:=f.Path, ImportMap:=Nothing, Overwrite:=True, Destination:=AnfZelle
50.
                ' Die erste XML-Datei ist importiert also setze firstImport = False
51.
                firstImport = False
52.
            End If
53.
        End If
54.
    Next
55.
    
56.
    'Funktion rekursiv für alle Unterordner ausführen
57.
    If boolRecursion Then
58.
        For Each subFolder In strFldr.SubFolders
59.
            parseFolder subFolder, True
60.
        Next
61.
    End If
62.
End Function
Grüße Uwe
Bitte warten ..
Mitglied: a.grothe
28.11.2013 um 12:33 Uhr
Danke für die Hilfe es klappt.
Bitte warten ..
Mitglied: colinardo
28.11.2013 um 12:34 Uhr
Dann den Beitrag bitte noch als gelöst markieren. Merci.
Grüße Uwe
Bitte warten ..
Ähnliche Inhalte
VB for Applications
XML Datei auslesen mit Excel
Frage von kaiuwe28VB for Applications10 Kommentare

Hallo zusammen, ich mal wieder Leider komme ich nicht weiter. Ich möchte aus einem Ordner mit mehreren XML Dateien ...

XML
XML Datei Fehler?
Frage von Patrick-ITXML1 Kommentar

Hallo zusammen ich benutze Sysprep, um ein Image von einer Maschine zu machen und lade dieses dann auf einem ...

XML

Einlesen bestimmten Werten, Texten aus XML- Datei in EXCEL

gelöst Frage von EverestXML11 Kommentare

Hallo Experten, ich möchte in Excel die Werte/Texte aus einer XML-Datei direkt lesen ohne sie zu importieren. Kann jemand ...

VB for Applications

Excel VBA XML-Nodes auslesen

Frage von chef1568VB for Applications4 Kommentare

Hallo zusammen, ich lese eine XML-Datei mittels DOMDocument-Methode aus. Ich möchte nun den Wert von <Text> aus der Stellenbezeichnung ...

Neue Wissensbeiträge
Viren und Trojaner

Staatstrojaner soll auch per Einbruch installiert werden können

Information von transocean vor 1 TagViren und Trojaner2 Kommentare

Moin, Bundesinnenminister Horst Seehofer will dem Verfassungsschutz Wohnungseinbrüche erlauben, um den geplanten Staatstrojaner zu installieren. Gruß Uwe

Windows 7
Win7 Update scheitert KB4512506
Information von infowars vor 1 TagWindows 7

Falls jemand auch das Problem hat mit dem: Monatliches Sicherheitsqualitätsrollup für Windows 7 für x64-basierte-Systeme (KB4512506) Das scheint mit ...

Humor (lol)
Wenn hacken nach hinten los geht
Information von em-pie vor 2 TagenHumor (lol)5 Kommentare

Moin, weil heute Freitag ist, nachfolgender kurzer Artikel zum schmunzeln:) l+f: NULL ist ein notorischer Falschparker

Windows Update
Windows: August 2019 Patchday-Probleme
Information von kgborn vor 3 TagenWindows Update3 Kommentare

Ich kippe mal einige kurze Informationen hier rein - vielleicht hilft es Betroffenen. Die August 2019-Updates für Windows haben ...

Heiß diskutierte Inhalte
Switche und Hubs
Glasfaser-Anschluss Telekom muss verteilt werden
Frage von cansoniSwitche und Hubs26 Kommentare

Vorweg: Bin nur Anwender und kein Experte Die Situation: Der Vermieter stellt einen Glasfaseranschluss in der Wohnung bereit. Wir ...

Hyper-V
VMs von Hyper-V auf externer Festplatte
Frage von SnowbirdHyper-V15 Kommentare

Hallo, ich möchte gerne von VirtualBox auf Hyper-V umsteigen und würde auch gerne weiterhin meine VMs auf der externen ...

Ubuntu
Download manchmal langsam oder komplette Abbrüche bzw. Videos spielen nicht bis zum Schluss
Frage von stefanstpUbuntu14 Kommentare

Immer wieder berichten unsere Kunden, dass Downloads abbrechen oder super langsam sind oder Videos nicht abgespielt werden können bzw. ...

Festplatten, SSD, Raid
SSDs durch Lagerung ohne Strom nach 6 Monaten defekt?!?
gelöst Frage von GlobetrotterFestplatten, SSD, Raid13 Kommentare

Moin Gemeinde Ich hatte gerade nen Trauerspiel Habe hier etliche NAS-Geräte herumfahren welche ich mal auf die Seite gelegt ...