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

Excel xml-Import

Frage Entwicklung VB for Applications

Mitglied: goodbytes

goodbytes (Level 2) - Jetzt verbinden

30.01.2013 um 21:41 Uhr, 3099 Aufrufe, 4 Kommentare

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):

01.
Option Explicit 
02.
 
03.
Sub XML_Auslesen() 
04.
 
05.
Const XMLDATEIPFAD As String = "C:\Test.xml" 
06.
 
07.
Dim xmlDoc As MSXML2.DOMDocument 
08.
Dim xmlKnoten As MSXML2.IXMLDOMNode 
09.
Dim xmlKnotenListe As MSXML2.IXMLDOMNodeList 
10.
Dim xmlGeladen As Boolean 
11.
Dim i As Integer, Zaehler As Integer 
12.
 
13.
Set Zaehler = 0 
14.
 
15.
Set xmlDoc = CreateObject("MSXML2.DOMDocument") 
16.
xmlGeladen = xmlDoc.Load(XMLDATEIPFAD) 
17.
 
18.
Set xmlKnoten = xmlDoc.SelectSingleNode("order") 
19.
 
20.
For i = 1 To 1000 
21.
 
22.
  If xmlDoc.nodeName = xmlKnoten Then 
23.
        Zaehler = Zaehler + 1 
24.
        Set xmlKnoten = xmlDoc.SelectSingleNode("TypesAndConstants") 
25.
         Auswerten xmlKnoten 
26.
  End If 
27.
 
28.
Next i 
29.
 
30.
End Sub 
31.
 
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
Mitglied: goodbytes
31.01.2013 um 06:22 Uhr
Hat Keiner einen Tipp für mich... ?
Bitte warten ..
Mitglied: rubberman
31.01.2013 um 18:41 Uhr
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
Bitte warten ..
Mitglied: goodbytes
04.02.2013, aktualisiert um 08:26 Uhr
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):

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

01.
Attribute VB_Name = "TB_xml_Import" 
02.
' XML-Import-Schnittstelle Tönnies, Torsten Bank, 31. Januar 2013 
03.
 
04.
Option Explicit 
05.
 
06.
Sub Auto_Open() 
07.
 
08.
Dim XMLDATEIPFAD, xmlGeladen As Boolean 
09.
Dim xmlDoc, xmlTransfer, xmlData, xmlOrder 
10.
Dim xmlKnoten1, xmlKnoten2, xmlKnoten3, xmlKnoten4, xmlKnoten5, xmlKnoten6, x As Integer 
11.
 
12.
' XMLDATEIPFAD = Application.GetOpenFilename() 
13.
XMLDATEIPFAD = ThisWorkbook.Path & "\Import.xml" 
14.
 
15.
Set xmlDoc = CreateObject("MSXML2.DOMDocument") 
16.
Set xmlTransfer = CreateObject("MSXML2.DOMDocument") 
17.
xmlGeladen = xmlDoc.Load(XMLDATEIPFAD) 
18.
 
19.
If xmlGeladen = False Then 
20.
    MsgBox "Bitte erst die XML-Datei in den Quellordner kopieren!" 
21.
Else 
22.
                  
23.
Sheets(1).Select 
24.
Range("A1").Select 
25.
 
26.
Set xmlTransfer = xmlDoc.SelectSingleNode("transfer") 
27.
     
28.
    For Each xmlKnoten1 In xmlTransfer.ChildNodes 
29.
     
30.
        With xmlKnoten1 
31.
             
32.
            x = 1 
33.
             
34.
            If xmlKnoten1.BaseName = "transferInfo" Then 
35.
                 
36.
               For Each xmlKnoten2 In xmlKnoten1.ChildNodes 
37.
                         
38.
                        Select Case True  
39.
                            Case xmlKnoten2.BaseName = "exportdate" 
40.
                                ActiveCell.Offset(x, 7).Value = .SelectSingleNode("exportdate").Text 
41.
                            Case xmlKnoten2.BaseName = "pinnumber" 
42.
                                ActiveCell.Offset(x, 10).Value = .SelectSingleNode("pinnumber").Text 
43.
                        End Select 
44.
                         
45.
                Next xmlKnoten2 
46.
 
47.
            End If 
48.
             
49.
            x = 1 
50.
             
51.
            If xmlKnoten1.BaseName = "data" Then 
52.
                
53.
                For Each xmlKnoten3 In xmlKnoten1.ChildNodes 
54.
                     
55.
                    If xmlKnoten3.BaseName = "order" Then 
56.
                     
57.
                        For Each xmlKnoten4 In xmlKnoten3.ChildNodes 
58.
 
59.
                            Select Case True 
60.
 
61.
                                Case xmlKnoten4.BaseName = "articledescription" 
62.
                                    ActiveCell.Offset(x, 0).Value = xmlKnoten4.Text 
63.
                                Case xmlKnoten4.BaseName = "factory" 
64.
                                    ActiveCell.Offset(x, 1).Value = xmlKnoten4.Text 
65.
                                Case xmlKnoten4.BaseName = "comment" 
66.
                                    ActiveCell.Offset(x, 1).Value = xmlKnoten4.Text 
67.
                                Case xmlKnoten4.BaseName = "number" 
68.
                                    ActiveCell.Offset(x, 2).Value = xmlKnoten4.Text 
69.
                                Case xmlKnoten4.BaseName = "charge" 
70.
                                    ActiveCell.Offset(x, 3).Value = xmlKnoten4.Text 
71.
                                Case xmlKnoten4.BaseName = "articlenumber" 
72.
                                    ActiveCell.Offset(x, 4).Value = xmlKnoten4.Text 
73.
                                Case xmlKnoten4.BaseName = "bestbeforedate" 
74.
                                    ActiveCell.Offset(x, 5).Value = xmlKnoten4.Text 
75.
                                Case xmlKnoten4.BaseName = "date" 
76.
                                    ActiveCell.Offset(x, 5).Value = xmlKnoten4.Text 
77.
                                Case xmlKnoten4.BaseName = "customer" 
78.
                                    ActiveCell.Offset(x, 8).Value = xmlKnoten4.Text 
79.
                                Case xmlKnoten4.BaseName = "positions" 
80.
                                 
81.
                                For Each xmlKnoten5 In xmlKnoten4.ChildNodes 
82.
                                         
83.
                                    If xmlKnoten5.BaseName = "position" Then 
84.
                                             
85.
                                        For Each xmlKnoten6 In xmlKnoten5.ChildNodes 
86.
                                            If xmlKnoten6.BaseName = "requirement" Then 
87.
                                                   ActiveCell.Offset(x, 9).Value = xmlKnoten6.Text 
88.
                                            End If 
89.
                                        Next xmlKnoten6 
90.
                                         
91.
                                    End If 
92.
                             
93.
                                Next xmlKnoten5 
94.
                                     
95.
                            End Select 
96.
 
97.
                        Next xmlKnoten4 
98.
                         
99.
                    End If 
100.
                     
101.
                    x = x + 1 
102.
                     
103.
                Next xmlKnoten3 
104.
                 
105.
            End If 
106.
             
107.
        End With 
108.
         
109.
    Next xmlKnoten1 
110.
 
111.
    Set xmlDoc = Nothing 
112.
 
113.
End If 
114.
 
115.
End Sub
Gruß
Torsten
Bitte warten ..
Mitglied: rubberman
04.02.2013, aktualisiert um 23:39 Uhr
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:
01.
Option Explicit 
02.
 
03.
Sub Auto_Open() 
04.
 
05.
Dim xmlDoc As New MSXML2.DOMDocument 
06.
Dim xmlData As MSXML2.IXMLDOMNode, xmlOrder As MSXML2.IXMLDOMNode, _ 
07.
    xmlKnoten1 As MSXML2.IXMLDOMNode, xmlKnoten2 As MSXML2.IXMLDOMNode, _ 
08.
    xmlKnoten3 As MSXML2.IXMLDOMNode, xmlKnoten4 As MSXML2.IXMLDOMNode, _ 
09.
    xmlKnoten5 As MSXML2.IXMLDOMNode, xmlKnoten6 As MSXML2.IXMLDOMNode 
10.
Dim XMLDATEIPFAD As String, req As String 
11.
Dim x As Long 
12.
Dim rng As Excel.Range 
13.
 
14.
XMLDATEIPFAD = ThisWorkbook.Path & "\Import.xml" 
15.
 
16.
If Not xmlDoc.Load(XMLDATEIPFAD) Then 
17.
    MsgBox "Bitte erst die XML-Datei in den Quellordner kopieren!", vbCritical, "Ladefehler" 
18.
Else 
19.
    Set rng = ThisWorkbook.Worksheets(1).Cells(1, 1) 
20.
    For Each xmlKnoten1 In xmlDoc.documentElement.childNodes 
21.
        With xmlKnoten1 
22.
            x = 1 
23.
            If xmlKnoten1.nodeName = "transferInfo" Then 
24.
                For Each xmlKnoten2 In xmlKnoten1.childNodes 
25.
                    Select Case True 
26.
                        Case xmlKnoten2.nodeName = "exportdate" 
27.
                            rng.Offset(x, 7).Value = .selectSingleNode("exportdate").Text 
28.
                        Case xmlKnoten2.nodeName = "pinnumber" 
29.
                            rng.Offset(x, 10).Value = .selectSingleNode("pinnumber").Text 
30.
                    End Select 
31.
                Next xmlKnoten2 
32.
            ElseIf .nodeName = "data" Then 
33.
                For Each xmlKnoten3 In .childNodes 
34.
                    If xmlKnoten3.nodeName = "order" Then 
35.
                        req = "" 
36.
                        For Each xmlKnoten4 In xmlKnoten3.childNodes 
37.
                            Select Case True 
38.
                                Case xmlKnoten4.nodeName = "articledescription" 
39.
                                    rng.Offset(x, 0).Value = xmlKnoten4.Text 
40.
                                Case xmlKnoten4.nodeName = "factory" 
41.
                                    rng.Offset(x, 1).Value = xmlKnoten4.Text 
42.
                                Case xmlKnoten4.nodeName = "comment" 
43.
                                    rng.Offset(x, 1).Value = xmlKnoten4.Text 
44.
                                Case xmlKnoten4.nodeName = "number" 
45.
                                    rng.Offset(x, 2).Value = xmlKnoten4.Text 
46.
                                Case xmlKnoten4.nodeName = "charge" 
47.
                                    rng.Offset(x, 3).Value = xmlKnoten4.Text 
48.
                                Case xmlKnoten4.nodeName = "articlenumber" 
49.
                                    rng.Offset(x, 4).Value = xmlKnoten4.Text 
50.
                                Case xmlKnoten4.nodeName = "bestbeforedate" 
51.
                                    rng.Offset(x, 5).Value = xmlKnoten4.Text 
52.
                                Case xmlKnoten4.nodeName = "date" 
53.
                                    rng.Offset(x, 5).Value = xmlKnoten4.Text 
54.
                                Case xmlKnoten4.nodeName = "customer" 
55.
                                    rng.Offset(x, 8).Value = xmlKnoten4.Text 
56.
                                Case xmlKnoten4.nodeName = "positions" 
57.
                                    For Each xmlKnoten5 In xmlKnoten4.childNodes 
58.
                                        If xmlKnoten5.nodeName = "position" Then 
59.
                                            For Each xmlKnoten6 In xmlKnoten5.childNodes 
60.
                                                If xmlKnoten6.nodeName = "requirement" Then 
61.
                                                    req = req & vbLf & xmlKnoten6.Text 
62.
                                                End If 
63.
                                            Next xmlKnoten6 
64.
                                        End If 
65.
                                    Next xmlKnoten5 
66.
                            End Select 
67.
                        Next xmlKnoten4 
68.
                        If Len(req) Then rng.Offset(x, 9).Value = Mid(req, 2) 
69.
                        x = x + 1 
70.
                    End If 
71.
                Next xmlKnoten3 
72.
            End If 
73.
        End With 
74.
    Next xmlKnoten1 
75.
End If 
76.
 
77.
End Sub
Grüße
rubberman
Bitte warten ..
Neuester Wissensbeitrag
Windows 10

Powershell 5 BSOD

(8)

Tipp von agowa338 zum Thema Windows 10 ...

Ähnliche Inhalte
VB for Applications
gelöst Excel VBA .csv Import in Tabelle x, ab Spalte y

Frage von drimrim zum Thema VB for Applications ...

Microsoft Office
gelöst SharePoint, Word, Excel. Auslesen mittels VBA und XML (10)

Frage von schwazza zum Thema Microsoft Office ...

VB for Applications
Excel VBA XML-Nodes auslesen (4)

Frage von chef1568 zum Thema VB for Applications ...

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

Frage von Xaero1982 zum Thema Microsoft ...

Windows Update
Treiberinstallation durch Windows Update läßt sich nicht verhindern (17)

Frage von liquidbase zum Thema Windows Update ...

Windows Tools
gelöst Aussendienst Datensynchronisierung (12)

Frage von lighningcrow zum Thema Windows Tools ...

Windows Server
RODC über VPN - Verbindung weg (10)

Frage von stefan2k1 zum Thema Windows Server ...