使用 VBA 循环遍历 XML

Posted 2023-02-22

【中文标题】使用 VBA 循环遍历 XML

【英文标题】：Looping through XML using VBA

【发布时间】：2013-11-30 00:30:57

【问题描述】：

我正在尝试使用 VBA 循环遍历以下简单的 XML，最终目标是能够轻松地按顺序提取数据。

<?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>

到目前为止，我的代码设法将数据放入即时窗口，但不是按照我需要的顺序。它应该是： 员工姓名 Person1 开口 1.1 闭包 1.11 员工姓名 人 2 开口 2.2 闭包 2.22 等

意思是我需要使我的递归函数具体化，而不是循环所有节点。 任何帮助将不胜感激！这就是我目前所拥有的......

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

输出：

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

【讨论】：

您好，感谢您的回复。这很有意义，我在那里学到了很多东西！ :-)

@Jiminy Cricket 很高兴它有帮助！

它非常有用。谢谢@dee