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

回答1:

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

来源：https://stackoverflow.com/questions/20020990/looping-through-xml-using-vba