Excel xml-Import

Hallo,
ich stehe gerade vor einem dringenden Schnittstellenproblem. Täglich muss eine xml-Datei mit vielen Datensätzen importiert werden und bestimmte Nodes übernommen werden.

Hier erstmal mein Ausgangscode (die erforderliche Lib ist als Verweis eingebunden):

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
Option Explicit

Sub XML_Auslesen()

Const XMLDATEIPFAD As String = "C:\Test.xml"  

Dim xmlDoc As MSXML2.DOMDocument
Dim xmlKnoten As MSXML2.IXMLDOMNode
Dim xmlKnotenListe As MSXML2.IXMLDOMNodeList
Dim xmlGeladen As Boolean
Dim i As Integer, Zaehler As Integer

Set Zaehler = 0

Set xmlDoc = CreateObject("MSXML2.DOMDocument")  
xmlGeladen = xmlDoc.Load(XMLDATEIPFAD)

Set xmlKnoten = xmlDoc.SelectSingleNode("order")  

For i = 1 To 1000

  If xmlDoc.nodeName = xmlKnoten Then
        Zaehler = Zaehler + 1
        Set xmlKnoten = xmlDoc.SelectSingleNode("TypesAndConstants")  
         Auswerten xmlKnoten
  End If

Next i

End Sub

Wenn der Knoten "order" gefunden wird sollen alle Unterknoten durchlaufen werden und die benötigten Knoten mittels "Select Case" weiterverarbeitet werden. Wenn alle Unterknoten von "order" durchlaufen wurden gehts weiter bis zum nächsten "order". Den "Zaehler" habe ich nur reingenommen, weil ich dann per Cell-Offset in die nächste Zeile des Ziel-Sheets springen muss.

Es ist sicher nur eine Kleinigkeit, aber irgendwie komme ich nicht klar. Der Aufbau der "Select Case" Geschichte ist dann schon klar. Es geht mir nur um das "Abklappern" der "nodeName" in der oberen Struktur und dann der Unterknoten in der Funktion zur Auswertung.

Vielen Dank schon mal im Voraus !!!

Torsten

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

Content-ID: 197958

Url: https://administrator.de/forum/excel-xml-import-197958.html

Ausgedruckt am: 04.04.2025 um 07:04 Uhr

4 Kommentare

Neuester Kommentar

Hat Keiner einen Tipp für mich... ?

Hallo TorstenB,

gib mal etwas mehr Info über die Struktur der XML Datei. Wo liegt der Knoten order? Direkt unter dem Root? Was verstehst du unter Unterknoten? Im engeren Sinne direkt unter order oder rekursiv in die Tiefe? Vielleicht konstruierst du mal ein kleines Beispiel mit 2-3 auszulesenden Datensätzen mit erdachten Daten. Das vereinfacht die Sache erheblich und wir haben was zum Testen für unsere Ideen

Grüße
rubberman

Hallo rubberman,
ich hab mich da jetzt durchgekämpft und es funktioniert. Hier meine Lösung, vielleicht steht ja mal jemand vor dem selben Problem und will nicht so viele Stunden dranhängen wie ich.

Zuerst mal einen Teil der XML-Struktur (damit man meine Lösung nachvollziehen kann):

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
<?xml version="1.0" encoding="iso-8859-1"?>  
<transfer type="Lims.Order" version="1.0.0" pinnumber="">  
  <transferInfo>
    <pinnumber>Test-001</pinnumber>
    <exportdate>25.01.2013</exportdate>
    <exporttime>10:09:51</exporttime>
    <exportuser>testuser</exportuser>
  </transferInfo>
  <data Count="1">  
    <order>
      <number>Test-1</number>
      <providernumber>10060</providernumber>
      <date>25.01.2013</date>
      <unserzeichen>tb</unserzeichen>
      <articlenumber>2222</articlenumber>
      <charge>2500</charge>
      <samplecount />
      <sachbearbeiterlogin>testuser</sachbearbeiterlogin>
      <user>test user</user>
      <usertelefon>0123-456789</usertelefon>
      <userfax />
      <useremail> testuser@mydomain.de </useremail>
      <description />
      <comment>Bla Bla Bla</comment>
      <endtext />
      <signature />
      <enclosure />
      <lastchange />
      <lastchangeuser />
      <imprinted />
      <exported>0</exported>
      <exporteddate />
      <export>1</export>
      <receivedby />
      <dateofreceive />
      <articledescription>Test-Objekt</articledescription>
      <bestbeforeinfo />
      <bestbeforedate>24.01.2013</bestbeforedate>
      <weight />
      <einheit />
      <verpackunggewicht />
      <packingunitofmeasure />
      <manufacturer>Test GmbH</manufacturer>
      <packing />
      <range>A</range>
      <articleadditiontext1 />
      <factory>Test-Objekt</factory>
      <commission />
      <homeland />
      <eilig>0</eilig>
      <dateinfo />
      <modeofdispatch />
      <bestbefore />
      <rechnungbezahlt>0</rechnungbezahlt>
      <project />
      <customer />
      <positions Count="6">  
        <position>
          <index>A</index>
          <requirement>Test 1</requirement>
        </position>
        <position>
          <index>A</index>
          <requirement>Test 2</requirement>
        </position>
        <position>
          <index>A</index>
          <requirement>STest 3</requirement>
        </position>
        <position>
          <index>A</index>
          <requirement>Test 4</requirement>
        </position>
      </positions>
    </order>
  </data>
</transfer>

Hier nun mein Makro, mit dem ich die gewünschten Informationen herausziehe:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
Attribute VB_Name = "TB_xml_Import"  
' XML-Import-Schnittstelle Tönnies, Torsten Bank, 31. Januar 2013  

Option Explicit

Sub Auto_Open()

Dim XMLDATEIPFAD, xmlGeladen As Boolean
Dim xmlDoc, xmlTransfer, xmlData, xmlOrder
Dim xmlKnoten1, xmlKnoten2, xmlKnoten3, xmlKnoten4, xmlKnoten5, xmlKnoten6, x As Integer

' XMLDATEIPFAD = Application.GetOpenFilename()  
XMLDATEIPFAD = ThisWorkbook.Path & "\Import.xml"  

Set xmlDoc = CreateObject("MSXML2.DOMDocument")  
Set xmlTransfer = CreateObject("MSXML2.DOMDocument")  
xmlGeladen = xmlDoc.Load(XMLDATEIPFAD)

If xmlGeladen = False Then
    MsgBox "Bitte erst die XML-Datei in den Quellordner kopieren!"  
Else
                 
Sheets(1).Select
Range("A1").Select  

Set xmlTransfer = xmlDoc.SelectSingleNode("transfer")  
    
    For Each xmlKnoten1 In xmlTransfer.ChildNodes
    
        With xmlKnoten1
            
            x = 1
            
            If xmlKnoten1.BaseName = "transferInfo" Then  
                
               For Each xmlKnoten2 In xmlKnoten1.ChildNodes
                        
                        Select Case True 
                            Case xmlKnoten2.BaseName = "exportdate"  
                                ActiveCell.Offset(x, 7).Value = .SelectSingleNode("exportdate").Text  
                            Case xmlKnoten2.BaseName = "pinnumber"  
                                ActiveCell.Offset(x, 10).Value = .SelectSingleNode("pinnumber").Text  
                        End Select
                        
                Next xmlKnoten2

            End If
            
            x = 1
            
            If xmlKnoten1.BaseName = "data" Then  
               
                For Each xmlKnoten3 In xmlKnoten1.ChildNodes
                    
                    If xmlKnoten3.BaseName = "order" Then  
                    
                        For Each xmlKnoten4 In xmlKnoten3.ChildNodes

                            Select Case True

                                Case xmlKnoten4.BaseName = "articledescription"  
                                    ActiveCell.Offset(x, 0).Value = xmlKnoten4.Text
                                Case xmlKnoten4.BaseName = "factory"  
                                    ActiveCell.Offset(x, 1).Value = xmlKnoten4.Text
                                Case xmlKnoten4.BaseName = "comment"  
                                    ActiveCell.Offset(x, 1).Value = xmlKnoten4.Text
                                Case xmlKnoten4.BaseName = "number"  
                                    ActiveCell.Offset(x, 2).Value = xmlKnoten4.Text
                                Case xmlKnoten4.BaseName = "charge"  
                                    ActiveCell.Offset(x, 3).Value = xmlKnoten4.Text
                                Case xmlKnoten4.BaseName = "articlenumber"  
                                    ActiveCell.Offset(x, 4).Value = xmlKnoten4.Text
                                Case xmlKnoten4.BaseName = "bestbeforedate"  
                                    ActiveCell.Offset(x, 5).Value = xmlKnoten4.Text
                                Case xmlKnoten4.BaseName = "date"  
                                    ActiveCell.Offset(x, 5).Value = xmlKnoten4.Text
                                Case xmlKnoten4.BaseName = "customer"  
                                    ActiveCell.Offset(x, 8).Value = xmlKnoten4.Text
                                Case xmlKnoten4.BaseName = "positions"  
                                
                                For Each xmlKnoten5 In xmlKnoten4.ChildNodes
                                        
                                    If xmlKnoten5.BaseName = "position" Then  
                                            
                                        For Each xmlKnoten6 In xmlKnoten5.ChildNodes
                                            If xmlKnoten6.BaseName = "requirement" Then  
                                                   ActiveCell.Offset(x, 9).Value = xmlKnoten6.Text
                                            End If
                                        Next xmlKnoten6
                                        
                                    End If
                            
                                Next xmlKnoten5
                                    
                            End Select

                        Next xmlKnoten4
                        
                    End If
                    
                    x = x + 1
                    
                Next xmlKnoten3
                
            End If
            
        End With
        
    Next xmlKnoten1

    Set xmlDoc = Nothing

End If

End Sub

Gruß
Torsten

Hallo TorstenB,

ja, so in der Form kann man das schon machen. Ein paar Anregungen (ohne dein Macro komplett umkrempeln zu wollen):

Die Deklaration der Variablen, wie du sie in deinem ersten Ansatz gebracht hast, hat mir besser gefallen.
Da du offensichtlich über Extras -> Verweise die Referenz auf Microsoft XML, v... gesetzt hast, kannst du statt mit der CreateObject() Funktion das XML Objekt auch mit New erzeugen.
Zeile 16? Nee. Das soll das documentElement werden (siehe Zeile 26, dort überschreibst du die Variable glücklicherweise).
baseName erfüllt eigentlich einen anderen Zweck (auch wenn es hier funktioniert) - nodeName ist die bessere Wahl
du könntest mit einer weiteren String-Variable alle Werte der requirement Knoten in eine Zelle bringen, statt nur des letzten.

Mit diesen und ein paar kleineren Änderungen könnte das so aussehen:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
Option Explicit

Sub Auto_Open()

Dim xmlDoc As New MSXML2.DOMDocument
Dim xmlData As MSXML2.IXMLDOMNode, xmlOrder As MSXML2.IXMLDOMNode, _
    xmlKnoten1 As MSXML2.IXMLDOMNode, xmlKnoten2 As MSXML2.IXMLDOMNode, _
    xmlKnoten3 As MSXML2.IXMLDOMNode, xmlKnoten4 As MSXML2.IXMLDOMNode, _
    xmlKnoten5 As MSXML2.IXMLDOMNode, xmlKnoten6 As MSXML2.IXMLDOMNode
Dim XMLDATEIPFAD As String, req As String
Dim x As Long
Dim rng As Excel.Range

XMLDATEIPFAD = ThisWorkbook.Path & "\Import.xml"  

If Not xmlDoc.Load(XMLDATEIPFAD) Then
    MsgBox "Bitte erst die XML-Datei in den Quellordner kopieren!", vbCritical, "Ladefehler"  
Else
    Set rng = ThisWorkbook.Worksheets(1).Cells(1, 1)
    For Each xmlKnoten1 In xmlDoc.documentElement.childNodes
        With xmlKnoten1
            x = 1
            If xmlKnoten1.nodeName = "transferInfo" Then  
                For Each xmlKnoten2 In xmlKnoten1.childNodes
                    Select Case True
                        Case xmlKnoten2.nodeName = "exportdate"  
                            rng.Offset(x, 7).Value = .selectSingleNode("exportdate").Text  
                        Case xmlKnoten2.nodeName = "pinnumber"  
                            rng.Offset(x, 10).Value = .selectSingleNode("pinnumber").Text  
                    End Select
                Next xmlKnoten2
            ElseIf .nodeName = "data" Then  
                For Each xmlKnoten3 In .childNodes
                    If xmlKnoten3.nodeName = "order" Then  
                        req = ""  
                        For Each xmlKnoten4 In xmlKnoten3.childNodes
                            Select Case True
                                Case xmlKnoten4.nodeName = "articledescription"  
                                    rng.Offset(x, 0).Value = xmlKnoten4.Text
                                Case xmlKnoten4.nodeName = "factory"  
                                    rng.Offset(x, 1).Value = xmlKnoten4.Text
                                Case xmlKnoten4.nodeName = "comment"  
                                    rng.Offset(x, 1).Value = xmlKnoten4.Text
                                Case xmlKnoten4.nodeName = "number"  
                                    rng.Offset(x, 2).Value = xmlKnoten4.Text
                                Case xmlKnoten4.nodeName = "charge"  
                                    rng.Offset(x, 3).Value = xmlKnoten4.Text
                                Case xmlKnoten4.nodeName = "articlenumber"  
                                    rng.Offset(x, 4).Value = xmlKnoten4.Text
                                Case xmlKnoten4.nodeName = "bestbeforedate"  
                                    rng.Offset(x, 5).Value = xmlKnoten4.Text
                                Case xmlKnoten4.nodeName = "date"  
                                    rng.Offset(x, 5).Value = xmlKnoten4.Text
                                Case xmlKnoten4.nodeName = "customer"  
                                    rng.Offset(x, 8).Value = xmlKnoten4.Text
                                Case xmlKnoten4.nodeName = "positions"  
                                    For Each xmlKnoten5 In xmlKnoten4.childNodes
                                        If xmlKnoten5.nodeName = "position" Then  
                                            For Each xmlKnoten6 In xmlKnoten5.childNodes
                                                If xmlKnoten6.nodeName = "requirement" Then  
                                                    req = req & vbLf & xmlKnoten6.Text
                                                End If
                                            Next xmlKnoten6
                                        End If
                                    Next xmlKnoten5
                            End Select
                        Next xmlKnoten4
                        If Len(req) Then rng.Offset(x, 9).Value = Mid(req, 2)
                        x = x + 1
                    End If
                Next xmlKnoten3
            End If
        End With
    Next xmlKnoten1
End If

End Sub