Looping through XML using VBA

Jiminy Cricket picture Jiminy Cricket · Nov 16, 2013 · Viewed 19.7k times · Source

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

Answer

Daniel Dušek picture Daniel Dušek · Nov 16, 2013
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