Top-Themen

AppleEntwicklungHardwareInternetLinuxMicrosoftMultimediaNetzwerkeOff TopicSicherheitSonstige SystemeVirtualisierungWeiterbildungZusammenarbeit

Aktuelle Themen

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

Frage Entwicklung VB for Applications

Mitglied: a.grothe

a.grothe (Level 1) - Jetzt verbinden

26.11.2013 um 12:49 Uhr, 8250 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 ..
Neuester Wissensbeitrag
Windows 10

Powershell 5 BSOD

(8)

Tipp von agowa338 zum Thema Windows 10 ...

Ähnliche Inhalte
Microsoft Office
gelöst Txt Dateien in Excel importieren (9)

Frage von Serbitar zum Thema Microsoft Office ...

Batch & Shell
CSV-Datei nach Excel importieren (5)

Frage von mrvfbnummer2 zum Thema Batch & Shell ...

Microsoft Office
Mehr als 20 Excel Dateien öffnen gleichzeitig (7)

Frage von PizzaPepperoni zum Thema Microsoft Office ...

VB for Applications
Bestimmte Daten aus eine CSV-Datei in eine Excel-Tabelle importieren (2)

Frage von MariaElena zum Thema VB for Applications ...

Heiß diskutierte Inhalte
Microsoft
Ordner mit LW-Buchstaben versehen und benennen (20)

Frage von Xaero1982 zum Thema Microsoft ...

Outlook & Mail
gelöst Outlook 2010 findet ost datei nicht (19)

Frage von Floh21 zum Thema Outlook & Mail ...

Netzwerkmanagement
gelöst Anregungen, kleiner Betrieb, IT-Umgebung (18)

Frage von Unwichtig zum Thema Netzwerkmanagement ...

Festplatten, SSD, Raid
M.2 SSD wird nicht erkannt (14)

Frage von uridium69 zum Thema Festplatten, SSD, Raid ...