I'm trying to loop through the following simple XML using VBA, with the ultimate goal to be able to easily extract the data in sequence.
<?xml version="1.0"?>
<PMRData>
<Staff StaffName="Person 1">
<Openings>1.1</Openings>
<Closures>1.11</Closures>
</Staff>
<Staff StaffName="Person 2">
<Openings>1.2</Openings>
<Closures>1.22</Closures>
</Staff>
<Staff StaffName="Person 3">
<Openings>1.3</Openings>
<Closures>1.33</Closures>
</Staff>
</PMRData>
My code so far manages to get the data into the Immediate Window but not in the order I need it. It should be: Staff Name Person1 Openings 1.1 Closures 1.11 Staff Name Person 2 Openings 2.2 Closures 2.22 etc.
Meaning i need to make my recursive function specific, rather than looping for all nodes. Any help would be greatly appreciated! This is what I have so far...
Dim xDoc As DOMDocument
Set xDoc = New DOMDocument
Dim xNode As IXMLDOMNode
Dim xElem As IXMLDOMElement
Dim xElemCount As Integer
Dim xSub As IXMLDOMElement
Dim Nodes As IXMLDOMNodeList
Set xElem = xDoc.SelectSingleNode("//PMRData")
Range("a1").Select
xElemCount = xElem.ChildNodes.Length
Debug.Print "xElem has " & xElemCount & " Nodes"
For Each xSub In xElem.ChildNodes
If xSub.Attributes.Length > 0 Then
For i = 0 To xSub.Attributes.Length - 1
Debug.Print xSub.Attributes(i).nodeName & " - " & xSub.Attributes(i).NodeValue
ActiveCell.Value = xSub.Attributes(i).nodeName
ActiveCell.Offset(0, 1).Value = xSub.Attributes(i).NodeValue
ActiveCell.Offset(1, 0).Select
Next i
End If
Next xSub
Set Nodes = xElem.SelectNodes("//PMRData")
For Each xNode In Nodes
DisplayNode xNode
Next xNode
End Sub
Public Sub DisplayNode(ByRef xNode As IXMLDOMNode)
Dim xNode2 As IXMLDOMNode
If xNode.NodeType = NODE_TEXT Then
Debug.Print "xNode = " & xNode.ParentNode.nodeName
Debug.Print "xNodeValue = " & xNode.NodeValue
End If
If xNode.HasChildNodes Then
For Each xNode2 In xNode.ChildNodes
DisplayNode xNode2
Next xNode2
End If
End Sub
Option Explicit
Private Const xml As String = "<PMRData>" & _
"<Staff StaffName='Person 1'>" & _
"<Openings>1.1</Openings>" & _
"<Closures>1.11</Closures>" & _
"</Staff>" & _
"<Staff StaffName='Person 2'>" & _
"<Openings>1.2</Openings>" & _
"<Closures>1.22</Closures>" & _
"</Staff>" & _
"<Staff StaffName='Person 3'>" & _
"<Openings>1.3</Openings>" & _
"<Closures>1.33</Closures>" & _
"</Staff>" & _
"</PMRData>"
Sub test()
Dim xDoc As DOMDocument
Set xDoc = New DOMDocument
If Not xDoc.LoadXML(xml) Then
Err.Raise xDoc.parseError.ErrorCode, , xDoc.parseError.reason
End If
Dim list As IXMLDOMNodeList
Set list = xDoc.SelectNodes("//PMRData/Staff")
Dim attr As IXMLDOMAttribute
Dim node As IXMLDOMNode
Dim childNode As IXMLDOMNode
For Each node In list
Set attr = node.Attributes.getNamedItem("StaffName")
If (Not attr Is Nothing) Then
Debug.Print attr.BaseName & " " & attr.Text
End If
If (node.HasChildNodes) Then
For Each childNode In node.ChildNodes
Debug.Print childNode.BaseName & " " & childNode.Text
Next childNode
End If
Next node
End Sub
Output:
StaffName Person 1
Openings 1.1
Closures 1.11
StaffName Person 2
Openings 1.2
Closures 1.22
StaffName Person 3
Openings 1.3
Closures 1.33
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With