Search code examples
xmlvbaloopsnodesmsxml

Looping through XML using VBA


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

Solution

  • 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