in

XML Daten per VBA lesen und Werte in Excel-Sheet ausgeben

Letzter Beitrag 03-18-2013 14:13 von Smartie. 18 Antworten.
Seite 1 von 2 (19 Treffer) 1 2 > Weiter
Beiträge sortieren: Zurück Weiter
  • 07-18-2012 18:16

    XML Daten per VBA lesen und Werte in Excel-Sheet ausgeben

    Hallo Leute, ich weiss, dass diese Thematik bereits exzessiv hier behandelt worden ist. Allerdings schaffe ich es einfach nicht aus den vorhandenen Code-Schnippseln ein passendes Programm für meinen Fall zu schreiben und hoffe sehr auf Eure Unterstützung: Ich habe folgende XML-Struktur, auf die ich zugreifen möchte: 
     
     
      <?xml version="1.0" encoding="Windows-1252" standalone="yes" ?>
    - <Data PpXmlVer="7.0">
    - <Objects>
    - <PmToolInstance ExternalId="14-Feb-2012__07_28_34_3332_5">
      <name>Bohrer, 5.0x85-K40</name>
      <comment />
      <attachments />
      <status>Open</status>
      <copies />
      <layout>14-Feb-2012__07_28_34_3332_5Layout</layout>
      <availability>0</availability>
      <percentUsed>0</percentUsed>
      <variant>NULL</variant>
      <relativeTo>NULL</relativeTo>
      <partDirections />
      <cycleTime>0</cycleTime>
      <usesTool />
      <amount>1</amount>
      <throughput>0</throughput>
      <prototype>08-Jun-2011__12_30_35_2064_1</prototype>
      <active>0</active>
    - <NodeInfo>
      <Id>3177156</Id>
      <Name>Bohrer, 5.0x85-K40</Name>
      <family>Resource</family>
    - <version>
    - <versionId>
      <idEntry>1</idEntry>
      <idEntry>223</idEntry>
      <idEntry>0</idEntry>
      <idEntry>0</idEntry>
      </versionId>
      <versionName>Modul</versionName>
      </version>
    - <status>
      <createdBy>amg</createdBy>
      <lastModifiedBy>mustermann</lastModifiedBy>
      <modificationDate>1/3/2012 7:59:59</modificationDate>
      </status>
      <cioState>0</cioState>
      </NodeInfo>
      </PmToolInstance>
    - <PmLayout ExternalId="14-Feb-2012__07_28_34_3332_5Layout">
      <name>Layout*</name>
      <comment />
      <attachments />
      <status>Open</status>
      <children />
    - <location>
      <item>0</item>
      <item>0</item>
      <item>-165.451</item>
      </location>
    - <rotation>
      <item>0</item>
      <item>0</item>
      <item>0</item>
      </rotation>
      <boundedBoxMin>0_0_0</boundedBoxMin>
      <boundedBoxMax>0_0_0</boundedBoxMax>
      <mountedTo>NULL</mountedTo>
      <mountedTools />
    - <NodeInfo>
      <Id>3177159</Id>
      <Name>Layout*</Name>
      <family>PmLayout</family>
    - <version>
    - <versionId>
      <idEntry>1</idEntry>
      <idEntry>223</idEntry>
      <idEntry>0</idEntry>
      <idEntry>0</idEntry>
      </versionId>
      <versionName>Modul</versionName>
      </version>
    - <status>
      <createdBy>amg</createdBy>
      <lastModifiedBy>amg</lastModifiedBy>
      <modificationDate>14/2/2012 15:57:32</modificationDate>
      </status>
    - <absoluteLocation>
      <x>0</x>
      <y>0</y>
      <z>-165.451</z>
      <rx>0</rx>
      <ry>0</ry>
      <rz>0</rz>
      </absoluteLocation>
      <cioState>0</cioState>
      </NodeInfo>
      </PmLayout>
    - <MB_BOHRER ExternalId="08-Jun-2011__12_30_35_2064_1">
      <name>Bohrer, 5.0x85-K40</name>
      <comment />
      <attachments />
      <status>Open</status>
      <type />
      <supplier>HAM</supplier>
      <costGroup />
      <operatingCostPerHour>0</operatingCostPerHour>
      <length>0</length>
      <width>0</width>
      <height>0</height>
      <material />
      <weight>0</weight>
      <image>NULL</image>
      <cadFile>NULL</cadFile>
      <threeDRep>NULL</threeDRep>
      <twoDRep>NULL</twoDRep>
      <children />
      <investmentCost>0</investmentCost>
      <variant>NULL</variant>
      <active>0</active>
      <web3DFile>NULL</web3DFile>
      <jtThreeDRep>NULL</jtThreeDRep>
      <CutterDiameter>5</CutterDiameter>
      <CutterLength>85</CutterLength>
      <DS>6</DS>
      <L3>30</L3>
      <MaxWorkDepth>28</MaxWorkDepth>
      <WS>120</WS>
      <version />
      <catalogNumber />
      <cadSystem>0</cadSystem>
      <boundedBoxMin>0_0_0</boundedBoxMin>
      <boundedBoxMax>0_0_0</boundedBoxMax>
      <NumberOfCuttingEdges>2</NumberOfCuttingEdges>
      <Bestellnummer>123</Bestellnummer>
      <CutterEdgeMaterialName>VHM</CutterEdgeMaterialName>
      <Sachnummer>F12345</Sachnummer>
      <ShankClass>ZYL</ShankClass>
      <TechnologyName>BOHREN_10-14</TechnologyName>
    - <NodeInfo>
      <Id>2473739</Id>
      <Name>Bohrer, 5.0x85-K40</Name>
      <family>ToolPrototype</family>
    - <version>
    - <versionId>
      <idEntry>1</idEntry>
      <idEntry>223</idEntry>
      <idEntry>0</idEntry>
      <idEntry>0</idEntry>
      </versionId>
      <versionName>Modul</versionName>
      </version>
    - <status>
      <createdBy>hans</createdBy>
      <lastModifiedBy>mustermann</lastModifiedBy>
      <modificationDate>1/3/2012 7:59:58</modificationDate>
      </status>
      <cioState>0</cioState>
      </NodeInfo>
      </MB_BOHRER>
      </Objects>
      </Data>
     
    Das VBA-Programm soll per Button_Click die ExternalId vom MB_Bohrer aus Zelle 'A3' in 'Tabelle1' nehmen (hier: "08-Jun-2011__12_30_35_2064_1") und dann in dem XML-Dokument danach suchen. Anschließend sollen bestimmte Kinderknoten dieses Bohrers (DS, L3, CutterLength, MaxWorkDepth) angewählt werden und die Werte in die Zellen 'B3', 'C3', 'D3', 'E3' ausgegeben werden... Ist das realisierbar? Könnte mir jemand bitte, bitte mit einem Code-Vorschlag unter die Arme greifen? Freue mich auf Eure Antworten. Besten Gruß, Michi
    • IP-Adresse ist Registriert
  • 07-19-2012 11:31 Antwort zu

    • Peter_Punkt
    • Top 10 Mitwirkender
    • Registriert am 03-28-2007
    • VS Community 2015, VB, C#, Office 2010, Win 10
    • Beiträge 2.605

    AW: XML Daten per VBA lesen und Werte in Excel-Sheet ausgeben

    So geht's:

    Am Einfachsten geht es, wenn man mit sog. XPath-Anweisungen in der XML-Datei sucht / navigiert.

    Das nachfolgende Beispiel zeigt die Vorgehenseise. Wichtig ist im VBA-Code einen Verweis auf 'Microsoft XML, v6.0' zu setzen, ansonsten kommen Fehlermeldungen.

    Code-Beispiel:

    ' Projekt:  Excel-Makro zum Auslesen von Werten aus einer XML-Datei
    '           Problemstellung: http://www.vb-magazin.de/forums/forums/p/6336/24960.aspx#24960
    '
    ' HINWEIS:  Über Menü 'Extra' Verweis setzen auf 'Microsoft XML, v6.0'
    '           damit u.a. mit XPath-Anweisungen zur Navigation gearbeitet werden kann
    '
    ' AUTOR:    Peter Punkt
    '
    ' Version:  01 - 19.07.2012
    
    Option Explicit
    
    Private Sub CommandButton1_Click()
    
       Const XMLDATEI As String = "D:\$PP\$XML\Bohrer.xml"  ' <--- ANPASSEN ---
       
       XMLDateiAuslesen XMLDATEI
       
    End Sub
    
    Private Sub XMLDateiAuslesen(ByVal XmlDateiMitPfad As String)
       
       Dim xmlDoc As New MSXML2.DOMDocument
       Dim xmlKnoten As IXMLDOMNode
       
       Dim xpathKnoten As String
       Dim xpathAttrib As String
       
       xmlDoc.async = False
       xmlDoc.validateOnParse = True                    ' Auf Fehler prüfen
       
       xmlDoc.Load (XmlDateiMitPfad)                    ' XML-Datei laden
       
       If xmlDoc.Load(XmlDateiMitPfad) = False Then
          MsgBox "XML-Datei: '" & XmlDateiMitPfad & "' wurde nicht gefunden"
          Exit Sub
       ElseIf xmlDoc.parseError = True Then
          MsgBox "XML-Datei: '" & XmlDateiMitPfad & "' hat fehlerhaften Aufbau (ist nicht 'wohlgeformt')"
          Exit Sub
       End If
       
       xmlDoc.setProperty "SelectionLanguage", "XPath"  ' Suchen soll mittels XPath erfolgen
       
       ' Auf <MB_BOHRER>-Knoten gehen und prüfen, ob der Wert des Attributs ExternalId übereinstimmt
       xpathKnoten = "/*/Objects/MB_BOHRER"                                 ' Knoten-Teil für die XPath-Anweisung
       xpathAttrib = "[@ExternalId='" & ActiveSheet.Range("A3") & "']"      ' Attribute-Teil für die XPath-Anweisung
       Set xmlKnoten = xmlDoc.selectSingleNode(xpathKnoten & xpathAttrib)   ' XPath-Anweisung mit Attribut-Vergleich
       
       If xmlKnoten Is Nothing Then
            MsgBox "Knoten nicht gefunden. Vermutlich falsche XML-Struktur"
            Exit Sub
       End If
       
       With ActiveSheet
          .Range("B3") = xmlKnoten.selectSingleNode("DS").Text
          .Range("C3") = xmlKnoten.selectSingleNode("L3").Text
          .Range("D3") = xmlKnoten.selectSingleNode("CutterLength").Text
          .Range("E3") = xmlKnoten.selectSingleNode("MaxWorkDepth").Text
       End With
    End Sub
    
    Zwar weiß ich viel, doch möcht' ich alles wissen.
    Dass ich erkenne, was die Welt im Innersten zusammenhält
    Abgelegt unter: , , ,
    • IP-Adresse ist Registriert
  • 07-19-2012 12:59 Antwort zu

    AW: XML Daten per VBA lesen und Werte in Excel-Sheet ausgeben

    Hallo Peter_Punkt!

    Du bist ein Genie, es klappt wunderbar. Hast mich jetzt sehr glücklich gemacht :)

     Besten Gruß, Michi

    • IP-Adresse ist Registriert
  • 07-19-2012 13:11 Antwort zu

    AW: XML Daten per VBA lesen und Werte in Excel-Sheet ausgeben

    Noch eine Frage dazu:

     In der obigen XML-Struktur ist der Knoten "NodeInfo" ein Kindknoten von "MB_Bohrer".

    Jetzt möchte ich gerne, dass zusätzlich zu der o.g. und von dir super umgesetzten Ausgabe von DS, Cutterlength etc. auch das Attribut "Id" des Kindes "NodeInfo" von "MB_BOHRER" in Zelle 'F3' ausgegeben wird...

    Im Gegensatz zur letzten Suche, habe ich ja jetzt kein explizites Attribut (z.B: ExternalId) wonach ich suchen kann...

    Wäre Dir/Euch sehr dankbar, wenn dieses Problem(chen?) auch noch gelöst werden könnte...

     

    Viele Grüße,

    Michael

    • IP-Adresse ist Registriert
  • 07-19-2012 13:25 Antwort zu

    AW: XML Daten per VBA lesen und Werte in Excel-Sheet ausgeben

    OK, das Problem mit der Id in NodeInfo habe ich jetzt selbst gelöst, indem ich einen xmKnoten2 entsprechend deinem Beispiel deklariert habe...

     Nächste Herausforderung:

    Jetzt gibt es XML-Dateien, die grundsätzlich analog zu der Beispieldatei strukturiert sind, aber unter NodeInfo mehrere Kinder haben, die aber alle DIE SELBE BEZEICHNUNG haben ("Id").

    Mit meiner Lösung bekomme ich aber nur den Text des ersten Id-Knotens heraus. Ich denk mal, dass man eine Schleife einbauen muss, damit der Text ALLER KINDER von "NodeInfo" ausgegeben wird.. Oder?! Wie könnte man so eine Schleife in dem Code implementieren?

     

    • IP-Adresse ist Registriert
  • 07-19-2012 18:15 Antwort zu

    • Peter_Punkt
    • Top 10 Mitwirkender
    • Registriert am 03-28-2007
    • VS Community 2015, VB, C#, Office 2010, Win 10
    • Beiträge 2.605

    AW: XML Daten per VBA lesen und Werte in Excel-Sheet ausgeben

    Antworten

    OK. ist nicht besonders schwierig.

    Poste mal eine XML-Datei mit mehreren Kindern, die aber alle DIE SELBE BEZEICHNUNG ("Id") haben als Anlage zu Deiner Antwort (geht über Register Optionen).

    Wohin sollen die Knoten-Werte gespeichert werden ? (der 1. Wert nach F3, der 2. Wert nach ???, der n-te Wert nach ???)

    Werde mein Code-Beispiel dann entsprechend anpassen und wieder ins Forum stellen.

    Zwar weiß ich viel, doch möcht' ich alles wissen.
    Dass ich erkenne, was die Welt im Innersten zusammenhält
    • IP-Adresse ist Registriert
  • 07-20-2012 14:00 Antwort zu

    AW: XML Daten per VBA lesen und Werte in Excel-Sheet ausgeben

    Sorry, ich meinte nicht den Punkt "Id" unter "NodeInfo", sondern den Punkt  "IdEntry" in dem bereits geposteten XML-Strukturbaum. Also unter: Data > Objects > MB_Bohrer > NodeInfo > version > versionId (siehe oben)! Hier gibt es vier Felder (manchmal auch zwei oder drei). Diese Werte sollten in die Zellen A6, A7, A8 etc. eingefügt werden...

    Kriegst du das hin?

    • IP-Adresse ist Registriert
  • 07-20-2012 17:02 Antwort zu

    • Peter_Punkt
    • Top 10 Mitwirkender
    • Registriert am 03-28-2007
    • VS Community 2015, VB, C#, Office 2010, Win 10
    • Beiträge 2.605

    AW: XML Daten per VBA lesen und Werte in Excel-Sheet ausgeben

    So geht's:

    Habe den Code jetzt so angepaßt, daß auch die Werte der mehrfach auftretenden <versionId>-Knoten übernommen werden.

    Code-Beispiel:

    ' Projekt:  Excel-Makro zum Auslesen von Werten aus einer XML-Datei
    '           Problemstellung: http://www.vb-magazin.de/forums/forums/p/6336/24960.aspx#24960
    '
    ' HINWEIS:  Über Menü 'Extra' Verweis setzen auf 'Microsoft XML, v6.0'
    '           damit u.a. mit XPath-Anweisungen zur Navigation gearbeitet werden kann
    '
    ' AUTOR:    Peter Punkt
    '
    ' Version:  02 - 20.07.2012
    
    Option Explicit
    
    Private Sub CommandButton1_Click()
    
       Const XMLDATEI As String = "D:\$PP\$XML\Bohrer.xml"  ' <--- ANPASSEN ---
       
       XMLDateiAuslesen XMLDATEI
       
    End Sub
    
    Private Sub XMLDateiAuslesen(ByVal XmlDateiMitPfad As String)
       
       Dim xmlDoc As New MSXML2.DOMDocument             ' XML-Dokument
       Dim xmlKnotenListe As MSXML2.IXMLDOMNodeList     ' Liste mit Knoten
       Dim xmlKnoten As IXMLDOMNode                     ' Einzelknoten
       Dim xmlKnoten2 As IXMLDOMNode                    ' Einzelknoten
       Dim xmlKnoten3 As IXMLDOMNode                    ' Einzelknoten
       
       Dim xpathKnoten As String
       Dim xpathAttrib As String
       
       Dim I As Integer
       
       xmlDoc.async = False
       xmlDoc.validateOnParse = True                    ' Auf Fehler prüfen
       
       xmlDoc.Load (XmlDateiMitPfad)                    ' XML-Datei laden
       
       If xmlDoc.Load(XmlDateiMitPfad) = False Then
          MsgBox "XML-Datei: '" & XmlDateiMitPfad & "' wurde nicht gefunden"
          Exit Sub
       ElseIf xmlDoc.parseError = True Then
          MsgBox "XML-Datei: '" & XmlDateiMitPfad & "' hat fehlerhaften Ausbau (ist nicht 'wohlgeformt')"
          Exit Sub
       End If
       
       xmlDoc.setProperty "SelectionLanguage", "XPath"  ' Suchen soll mittels XPath erfolgen
       
       ' Auf <MB_BOHRER>-Knoten gehen und prüfen, ob der Wert des Attributs ExternalId übereinstimmt
       xpathKnoten = "/*/Objects/MB_BOHRER"                                 ' Knoten-Pfad für die XPath-Anweisung
       xpathAttrib = "[@ExternalId='" & ActiveSheet.Range("A3") & "']"      ' Attribute-Vergleich für die XPath-Anweisung
       Set xmlKnoten = xmlDoc.selectSingleNode(xpathKnoten & xpathAttrib)   ' XPath-Anweisung mit Attribut-Vergleich
       
       If xmlKnoten Is Nothing Then
            MsgBox "<Objects/MB_BOHRER>-Knoten nicht gefunden. Vermutlich falsche XML-Struktur"
            Exit Sub
       End If
       
       xpathKnoten = "NodeInfo/version/versionId"                           ' Knoten-Pfad für die XPath-Anweisung
       Set xmlKnoten2 = xmlKnoten.selectSingleNode(xpathKnoten)             ' XPath-Anweisung
       If xmlKnoten2 Is Nothing Then
            MsgBox "<NodeInfo/version/versionId>-Knoten innerhalb <MB_BOHRER>-Knoten nicht gefunden. Vermutlich falsche XML-Struktur"
            Exit Sub
       End If
       
       Set xmlKnotenListe = xmlKnoten2.selectNodes("idEntry")   ' Liste aller <idEntry>-Knoten innerhalb des <versionId>-Knotens anlegen
    
       With ActiveSheet
          .Range("B3") = xmlKnoten.selectSingleNode("DS").Text
          .Range("C3") = xmlKnoten.selectSingleNode("L3").Text
          .Range("D3") = xmlKnoten.selectSingleNode("CutterLength").Text
          .Range("E3") = xmlKnoten.selectSingleNode("MaxWorkDepth").Text
          
          I = 6                                                 ' Zeilen-Nr. für den 1. Wert
          For Each xmlKnoten3 In xmlKnotenListe                 ' Liste durchlaufen
             .Range("A" & CStr(I)) = xmlKnoten3.Text            ' Wert in Excel-Tabelle speichern
             I = I + 1                                          ' Zeilen-Nr. erhöhen für nächsten Durchlauf
          Next
       End With
    End Sub
    
    Zwar weiß ich viel, doch möcht' ich alles wissen.
    Dass ich erkenne, was die Welt im Innersten zusammenhält
    Abgelegt unter: , , ,
    • IP-Adresse ist Registriert
  • 10-16-2012 15:46 Antwort zu

    AW: XML Daten per VBA lesen und Werte in Excel-Sheet ausgeben

    hallo zusammen, da ich vor einem sehr ähnlichen Problem stehe, hoffe ich, dass ihr mir bei meiner Problemstellung weiterhelfen könnt. Ich habe in einem Ordner viele .xml Dateien, aus denen ich bestimmte Werte in eine Excel Tabelle kopieren möchte. Alle .xml Dateien haben die gleiche Struktur. Aus folgendem Code hätte ich gerne die Werte zu "pruefumfangName", "testDuration", "errorCount" und "testTime" aus dem Knoten "testinfo". Am übersichtlichsten fände ich es, wenn diese in dem Excel sheet von A1 bis D1 fest angezeigt werden und die Werte aus den Dateien dann darunter eingetragen werden. Für Hilfestellungen jeglicher Art wäre ich sehr dankbar. http://imageshack.us/f/87/unbenanntet.png/ Beste Grüße Feitlinger P.S.: Wieso auch immer wird mein code hier nicht angezeigt. Wie kann ich diesen denn anzeigen lassen?
    • IP-Adresse ist Registriert
  • 10-19-2012 11:51 Antwort zu

    • Peter_Punkt
    • Top 10 Mitwirkender
    • Registriert am 03-28-2007
    • VS Community 2015, VB, C#, Office 2010, Win 10
    • Beiträge 2.605

    AW: XML Daten per VBA lesen und Werte in Excel-Sheet ausgeben

    Habe noch ein paar Fragen:

    1. Willst Du ein VBA-Makro machen, d.h. der Coded ist als Makro in der Excel-Datei gespeichert oder willst Du das Ganze als VBSript-Code?

    2. Kommt der Knoten <testinfo> in jeder XML-Datei nur 1x vor oder mehrmals?

    PS: Füge Deinen Code bei der Antwort über den Tab "Optionen" einfach als Anhang als .TXT-Datei hinzu.

    Zwar weiß ich viel, doch möcht' ich alles wissen.
    Dass ich erkenne, was die Welt im Innersten zusammenhält
    • IP-Adresse ist Registriert
  • 10-19-2012 12:54 Antwort zu

    AW: XML Daten per VBA lesen und Werte in Excel-Sheet ausgeben

    Hallo Peter, vielen Dank schonmal für deine Antwort. zu 1.: Ein VBA-Makro für Excel wäre überragend. zu 2.: der Knoten kommt in jeder Datei nur 1x vor. Nach der testinfo kommen nur noch mehrere Knoten , die ignoriert werden können. Ich bin gerade nicht auf der Arbeit, deswegen kann ich den code gerade nicht hier einstellen. Ich hoffe, dass die Infos von mir reichen. Schonmal 1000 Dank für deine Mühen. Viele Grüße Feitlinger
    • IP-Adresse ist Registriert
  • 10-19-2012 13:04 Antwort zu

    • Peter_Punkt
    • Top 10 Mitwirkender
    • Registriert am 03-28-2007
    • VS Community 2015, VB, C#, Office 2010, Win 10
    • Beiträge 2.605

    AW: XML Daten per VBA lesen und Werte in Excel-Sheet ausgeben

    Danke für die Antwort. Werde Dir am Wochenende ein VBA-Makro machen. Sollte eigentlich nicht zu schwierig sein. Muß mir aber erst ein paar XML-Dateien zum Testen machen (duzu muß ich mir Deine XML-Struktur nachbauen).

    Zwar weiß ich viel, doch möcht' ich alles wissen.
    Dass ich erkenne, was die Welt im Innersten zusammenhält
    • IP-Adresse ist Registriert
  • 10-19-2012 13:16 Antwort zu

    AW: XML Daten per VBA lesen und Werte in Excel-Sheet ausgeben

    suuuuuper! Vielen herzlichen dank.
    • IP-Adresse ist Registriert
  • 10-21-2012 17:24 Antwort zu

    • Peter_Punkt
    • Top 10 Mitwirkender
    • Registriert am 03-28-2007
    • VS Community 2015, VB, C#, Office 2010, Win 10
    • Beiträge 2.605

    AW: XML Daten per VBA lesen und Werte in Excel-Sheet ausgeben

    So geht's:

    Mittels FileSystemObject muß man zunächst alle Dateien im gewünschten Ordner auslesen und prüfen, welche auf .XML enden.

    In diesen XML-Dateien kann man dann mit XPath-Methoden sehr einfach navigieren und den gewünschten Knoten sowie die Attibute finden.

    Das Ganze ist als Excel-Makro geschreiben.

    WICHTIG ist, daß man im Excel Visual Basic Editor einen Verweis auf 'Microsoft XML, v6.0' setzt.

    Melde Dich nochmal, wenn Du Fragen oder Testergebnisse hast.

    Viel Erfolg !

    Code-Beispiel (getestet):

    ' Projekt:  Excel-Makro zum Auslesen von Werten aus mehreren, gleichartigen  XML-Dateien in einem Ordner
    '           Problemstellung: http://www.vb-magazin.de/forums/forums/p/6336/24960.aspx#24960
    '
    ' HINWEIS:  Über Menü 'Extra' Verweis setzen auf 'Microsoft XML, v6.0'
    '           damit u.a. mit XPath-Anweisungen zur Navigation gearbeitet werden kann
    '
    ' AUTOR:    Peter Punkt
    '
    ' Version:  01 - 19.10.2012
    
    Option Explicit
    
    Const XMLDATEIORDNER As String = "D:\$PP\$XML\Feitlinger2\" ' <--- ANPASSEN
    Const STARTSPALTE As String = "A"                           ' <--- ANPASSEN
    
    Dim fso As Object
    
    Sub XMLAuslesen()
    
    
        Dim ZeilenNr As Integer
        Dim fo As Object                                        ' Ordner
        Dim fi As Object                                        ' Datei
    
        ZeilenNr = 1
        Worksheets(1).Activate                                  ' Erstes Tabellenblatt
    
        Set fso = CreateObject("Scripting.FileSystemObject")
        Set fo = fso.GetFolder(XMLDATEIORDNER)
    
        For Each fi In fo.Files                                 ' Jede Datei im Ordner prüfen
            If LCase(Right(fi.Name, 4)) = ".xml" Then           ' Wenn xml-Datei dann ...
                XmlAttributeAuslesen XMLDATEIORDNER & fi.Name, ZeilenNr '  ... Sub aufrufen
                ZeilenNr = ZeilenNr + 1                         ' ZeilenNr erhöhen für nächste Datei
            End If
        Next
        
        MsgBox ("Fertig")
    
    End Sub
    
    ' ************************************************************************
    
    Sub XmlAttributeAuslesen(ByVal XmlDateiMitPfad As String, ByVal Zeile As Integer)
    
        Dim xmlDoc As New MSXML2.DOMDocument                    ' XML-Dokument
        Dim xmlKnoten As IXMLDOMNode                            ' XML-Einzelknoten
        
        Dim X As IXMLDOMNode
        Dim nsString As String                                  ' Namespace-String
        Dim xpathKnoten As String                               ' Knoten-Pfad für Suche mit XPath
        
        xmlDoc.async = False
        xmlDoc.validateOnParse = True                           ' Auf Fehler prüfen
        
        If fso.FileExists(XmlDateiMitPfad) = False Then         ' Prüfen ob Datei existiert
            MsgBox ("Datei: '" & XmlDateiMitPfad & "' nicht gefunden")
            Exit Sub
        End If
        
        ' HINWEIS ZU FEHLERMELDUNGEN: Siehe: http://support.microsoft.com/kb/275883/de
        If xmlDoc.Load(XmlDateiMitPfad) = False Then            ' XML-Datei laden
            MsgBox "Datei: '" & XmlDateiMitPfad & "' liefert beim Laden folgende Meldung: " _
                  & vbCrLf & xmlDoc.parseError.reason & " (Zeile: " & xmlDoc.parseError.Line & ")"
            Exit Sub
        ElseIf xmlDoc.parseError = True Then
            MsgBox "Datei: '" & XmlDateiMitPfad & "' hat fehlerhaften Aufbau (ist nicht 'wohlgeformt')"
            Exit Sub
        End If
       
        ' WICHTIG FALLS VOR DEN KNOTENNAMEN NAMESPACES BENUTZT WERDEN  (z.B. <pf1:person>):
        '       Die Namespaces aus dem Root-Knoten auslesen und zu einem String zusammenstellen,
        '       sonst werden die Knoten nicht gefunden
        Set xmlKnoten = xmlDoc.selectSingleNode("/*")           ' Den 1. Knoten (Root-Knoten) holen
        nsString = ""
        For Each X In xmlKnoten.Attributes                      ' Alle Attribute auslesen, aber ...
            If Left(X.XML, 5) = "xmlns" Then                    ' ... nur die Namespaces 'xmlns' verwenden
                nsString = nsString & " " & Replace(X.XML, """", "'")
            End If
        Next
        xmlDoc.setProperty "SelectionNamespaces", nsString      ' Die verwendeten Namespaces festlegen
        ' MsgBox nsString                                         ' <--- FÜR TESTRZWECKE
       
        xpathKnoten = "/testResult/testInfo"                    ' Knoten-Pfad für die XPath-Anweisung
        Set xmlKnoten = xmlDoc.selectSingleNode(xpathKnoten)    ' XPath-Anweisung
        
        If xmlKnoten Is Nothing Then
            MsgBox xpathKnoten & "-Knoten nicht gefunden. Vermutlich falsche XML-Struktur oder kein Namespace angegeben", _
                   vbCritical, XmlDateiMitPfad
            Exit Sub
        End If
               
        ActiveSheet.Range("$" & STARTSPALTE & "$" & Zeile).Select ' Aktive Zelle (z.B. $A$n) in der aktuellen Zeile festlegen
        With Application.ActiveCell                             ' Nach Excel übernehmen
            .Offset(0, 0).Value = xmlKnoten.Attributes.getNamedItem("pruefumfangName").Text
            .Offset(0, 1).Value = xmlKnoten.Attributes.getNamedItem("testDuration").Text
            .Offset(0, 2).Value = xmlKnoten.Attributes.getNamedItem("errorCount").Text
            .Offset(0, 3).Value = xmlKnoten.Attributes.getNamedItem("testTime").Text
        End With
        
    End Sub
    
    Zwar weiß ich viel, doch möcht' ich alles wissen.
    Dass ich erkenne, was die Welt im Innersten zusammenhält
    Abgelegt unter: , , ,
    • IP-Adresse ist Registriert
  • 10-21-2012 17:51 Antwort zu

    AW: XML Daten per VBA lesen und Werte in Excel-Sheet ausgeben

    Hallo Peter, vorerst möchte ich mich ganz herzlich bei dir für deine unglaublichen Mühen danken. Du hast mir Wochen Arbeit erspart. Ich werde dein Skript gleich morgen auf der Arbeit testen und natürlich sofort Feedback geben. Wünsche Dir noch einen schönen Sonntagabend. Viele Grüße aus dem sonnigen München Feitlinger
    • IP-Adresse ist Registriert
Seite 1 von 2 (19 Treffer) 1 2 > Weiter