xml daten einlesen
08.10.2015 13:24:47
marco
Ich bastelle momentan an eine Code, der mir ermöglicht Daten aus einer XML Strucktur ins Excel zu übernehmen.
Dazu habe ich mir folgende Prozedur aus dem Netz zusammen gestellt und bei mir angepasst.
Mein Problem ist:
Meine Eindeutige ID ist die der Adresse?
Bedeutet was ich suche: => Prüfe jeden Block, diese können Variiern, wenn Adresse gleich Wert aus ActiveSheet.Cells(3, spalten) dann SWVersion und HWVersion aus diesem Block übernehmen.
Anbei eine ausszug aus der xml strucktur
-----------------------------
1. Diagnosebloecke Anzahl="24"
2. Diagnoseblock Block="1"
3. Adresse>01
4. SWVersion>C029
5. HWVersion>Y12
------------------------------
Anbei mein Code. bei diesem Code werden die ID der Bloecke verglichen. diese sind aber leider nicht immer die gleichen ID nummern wire die Adresse darunter.
Sub IDEX_Einlesen()
Dim strAddr As String
Dim FW(1) As String
Dim XMLDATEI As String
Dim UserName As String
UserName = Application.UserName
strAddr = ActiveSheet.Shapes(Application.Caller).TopLeftCell.Address
FW(1) = Range(strAddr).Value
If UserName " Marco " Then
MsgBox UserName & "," & Chr(13) & Chr(13) & _
"Sorry, Sie sind nicht befugt dieses Makro zu starten!" & Chr(13) & Chr(13) _
& "Zugriff verweigert!"
Exit Sub
End If
XMLDATEI = "C:\Users\dellama\Desktop\test\" & FW(1) & ".xml" 'Bezugspfad mit variablen click befehl.
XMLDateiAuslesen XMLDATEI
End Sub
Private Sub XMLDateiAuslesen(ByVal XmlDateiMitPfad As String)
Dim spalten As Integer
Dim strAddr As String
strAddr = ActiveSheet.Shapes(Application.Caller).TopLeftCell.Address
Dim i As Integer
Dim FW(1) As String
FW(1) = Range(strAddr).Value
i = Range(Cells(6, 2), Cells(Rows.Count, 2)).Find(What:=FW(1)).Row
Dim xmlDoc As New MSXML2.DOMDocument
Dim xmlKnoten As IXMLDOMNode
Dim xpathKnoten As String
Dim xpathAttrib1 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
For spalten = 7 To 17
' Auf -Knoten gehen und prüfen, ob der Wert des Attributs Block ü _
bereinstimmt
xpathKnoten = "/*/Diagnosebloecke/Diagnoseblock" ' Knoten-Teil für die _
_
_
XPath-Anweisung
xpathAttrib1 = "[@Block ='" & ActiveSheet.Cells(3, spalten) & "']" ' Attribute-Teil1 für _
_
_
die XPath-Anweisung
Set xmlKnoten = xmlDoc.SelectSingleNode(xpathKnoten & xpathAttrib1) ' XPath-Anweisung _
mit Attribut-Vergleich
If xmlKnoten Is Nothing Then GoTo Weiter
With ActiveSheet
.Cells(i + 6, spalten) = xmlKnoten.SelectSingleNode("SWVersion").Text
.Cells(i + 3, spalten) = xmlKnoten.SelectSingleNode("HWVersion").Text
End With
Weiter:
Next spalten
End Sub