使用 VBA 从 XML 获取属性名称

Question

我需要使用 VBA 从 XML 中获取不同的属性名称。

这是我的代码。

 sub test() 
 Dim XMLFile As Object
Dim XMLFileName As String
Set XMLFile = CreateObject("Microsoft.XMLDOM")

XMLFileName = "C:\Users\Input.xml"
XMLFile.async = False
XMLFile.Load (XMLFileName)
XMLFile.validateOnParse = False

Dim mainnode As Object
Dim node As Object

Set mainnode = XMLFile.SelectNodes("//Elements")

For Each node In mainnode
    For Each child In node.ChildNodes
    Debug.Print child.BaseName
    Dim kiddo As Object
    For Each kiddo In child.ChildNodes
        Debug.Print kiddo.BaseName
    Next kiddo
Next child
Next node
End sub

这是示例 XML。我需要num从 XML 中获取属性名称。

<Elements>
<Details>
    <Name>ABC</Name>
    <Address>123ABC</Address>
    <College>
        <collname>safasf</collname>
         <collnumber/>
    </College>
</Details>  
<Dept num="123">
    <Deptname>IT</Deptname>
    <ID>A123</ID>
 </Dept>            
</Elements>

预期结果：

 Elements
 Details
 Name 
 Address
 College
 collname
 collnumber
 Dept
 num
 Deptname
 ID

上面代码的实际结果：

 Elements
 Details
 Name 
 Address
 College
 collname
 Dept
 Deptname
 ID

<collnumber/>我的代码未获取“num”属性和标签。有人可以让我知道如何使用 VBA 从 XML 中获取属性名称和标签名称吗

Answer 1

通过递归函数调用显示包含属性的 XML 结构

我的示例代码演示了一种方法

• [1] 使用 XMLDOM 方法将整个 XML 结构分配给一个二维数组
• [2] 可选择将其写回工作表。

放大提示：

我加了这些？结构化提示比仅显示代码提供更多帮助，正如我所说，其中许多要点也会导致其他用户重复提问：

• 尝试列出 XML结构时，随着节点元素层次深度的增加（类型常量 1 NODE_ELEMENT），您失去了良好的视野，因此我紧急建议使用 ? 本示例代码中使用的递归调用。
• 此外，您可能没有考虑到节点文本的特殊构造（类型常量 3 NODE_TEXT）是给定父元素的名称的第一个子元素 - 参见主函数中的 A. 和 B. 部分listChildNodes。 您通过子节点的循环不会区分提到的类型。只需研究引用函数中的注释即可了解详细信息。
• 我想您的 XML 文件以所需的处理指令开头，例如 eg <?xml version="1.0" encoding="utf-8"?>，以便它可以实际识别为 XML 文件。
• 调用过程DisplayXML()使用后期绑定而不是对 MS XML 的早期绑定引用，类似于您的帖子，但使用推荐的 MSXML2 版本 6.0。它通过其DocumentElement <Elements> （顺便说一句，单个节点元素）和引用预定义二维数组的第二个参数调用主函数v。
• 版本控制：如果您将XMLFILE对象设置为内存，Set XDoc = CreateObject("MSXML2.DOMDocument") 通常您将获得较旧的默认版本 (3.0)，因此在大多数情况下，最好使用显式Set XDoc = CreateObject("MSXML2.DOMDocument.6.0") 代替（自动包括 XPath）。
• 如果不使用该Load函数获取True（文件加载成功）或False（加载错误）返回，则无需将文件名设置在括号 () 中。
• //搜索字符串中的 XPath 运算符将返回任何级别的任何出现（参见XMLFile.SelectNodes("//Elements")您的 OP）。
• 还要考虑XSLT的使用，这是一种专门用于将 XML 文件转换为各种最终使用格式的语言。

调用程序 DisplayXML

提示：仅使用调用过程中的估计项数（例如 1000）来确定数组的行数就足够了，因为ReDim如果需要，主函数会自动执行 a （包括双转置）。尽管如此，我从一开始就通过 XPath/XMLDOM 表达式XMLFile.SelectNodes("//*").Length计算了整个文件中的任何项目，在这里添加了确切的项目计数。

Option Explicit          ' declaration head of your code module

Sub DisplayXML()
Dim XMLFile As Object
Dim XMLFileName As String
'Set XMLFile = CreateObject("Microsoft.XMLDOM")   ' former style not recommended
Set XMLFile = CreateObject("MSXML2.DOMDocument.6.0")

XMLFileName = "C:\Users\Input.xml"                             ' << change to your xml file name
XMLFile.Async = False
XMLFile.ValidateOnParse = False
Debug.Print XMLFile.XML

If XMLFile.Load(XMLFileName) Then
' [1] write xml info to array with exact or assumed items count
  Dim v As Variant: ReDim v(1 To XMLFile.SelectNodes("//*").Length, 1 To 2)
  listChildNodes XMLFile.DocumentElement, v                 ' call helper function

' [2] write results to sheet "Dump"                         ' change to your sheet name
  With ThisWorkbook.Worksheets("Dump")
       .Range("A:B") = ""                                   ' clear result range
       .Range("A1:B1") = Split("XML Tag,Node Value", ",")   ' titles
       .Range("A2").Resize(UBound(v), UBound(v, 2)) = v     ' get  2-dim info array
  End With
Else
       MsgBox "Load Error " & XMLFileName
End If
Set XMLFile = Nothing
End Sub

显示在工作表中的结构化结果

提示：如果你不想要级别缩进或枚举级别层次结构，你可以很容易地调整listChildNodes()下面的主要功能。

+----+---------------------+-----------------+
|    |         A           |       B         |
+----+---------------------+-----------------+
|1   | XML Tag             | Node Value      |
+----+---------------------+-----------------+
|2   | 0 Elements          |                 |
+----+---------------------+-----------------+
|3   |   1 Details         |                 |
+----+---------------------+-----------------+
|4   |     2 Name          | ABC             |
+----+---------------------+-----------------+
|5   |     2 Address       | 123ABC          |
+----+---------------------+-----------------+
|6   |     2 College       |                 |
+----+---------------------+-----------------+
|7   |       3 collname    | safasf          |
+----+---------------------+-----------------+
|8   |       3 collnumber  |                 |
+----+---------------------+-----------------+
|9   |   1 Dept[@num="123"]|                 |
+----+---------------------+-----------------+
|10  |     2 Deptname      | IT              |
+----+---------------------+-----------------+
|11  |     2 ID            | A123            |
+----+---------------------+-----------------+

也可以引用精确的节点元素，例如通过

listChildNodes XMLFile.DocumentElement.SelectSingleNode("Dept[@num=""123""]"),v, 1, 1       ' starting from item no 1 and Level no 1

这将单独列出指定的节点集：

+----+---------------------+-----------------+
|    |         A           |       B         |
+----+---------------------+-----------------+
|1   | XML Tag             | Node Value      |
+----+---------------------+-----------------+
|2   |   1 Dept[@num="123"]|                 |
+----+---------------------+-----------------+
|3   |     2 Deptname      | IT              |
+----+---------------------+-----------------+
|4   |     2 ID            | A123            |
+----+---------------------+-----------------+

递归主函数 listChildNodes()

循环遍历子节点集合，该函数重复（“递归”）调用自身（即当前节点对象）并将整个 XML 结构分配给给定的二维数组（第二个参数）。此外，它允许缩进并指示层次结构级别。请注意，此示例中的数组必须是基于 1 的。

Edit 20/8 2018如果项目计数器超过当前数组的上限（即在其第一维 = 项目数），则包括数组大小的自动增加。技术说明：由于在次要（此处为第 1 个）维度中不可能进行这样的操作，因此需要将“行”（dim 1）更改为“列”（dim 2）的中间换位。iUBound(v)ReDim

Function listChildNodes(oCurrNode As Object, _
                        ByRef v As Variant, _
                        Optional ByRef i As Long = 1, _
                        Optional iLvl As Integer = 0 _
                        ) As Boolean
' Purpose: assign the complete node structure with contents to a 1-based 2-dim array
' Author:  T.M.
' Note: Late binding XML doesn't allow the use of IXMLDOMNodeType enumeration constants
'       (1 ... NODE_ELEMENT, 2 ... NODE_ATTRIBUTE, 3 ... NODE_TEXT etc.)
' Escape
  If oCurrNode Is Nothing Then Exit Function
  If i < 1 Then i = 1                                       ' one based items Counter
' Edit 20/8 2018 - Automatic increase of array size if needed 
  If i >= UBound(v) Then                                    ' change array size if needed
     Dim tmp As Variant
     tmp = Application.Transpose(v)                         ' change rows to columns
     ReDim Preserve tmp(1 To 2, 1 To UBound(v) + 1000)      ' increase row numbers
     v = Application.Transpose(tmp)                         ' transpose back
     Erase tmp
  End If
  Const NAMEColumn& = 1, VALUEColumn& = 2                   ' constants for column 1 and 2
' Declare variables
  Dim oChildNode As Object                                  ' late bound node object
  Dim bDisplay   As Boolean
' ---------------------------------------------------------------------
' A. It's nothing but a TextNode (i.e. a parent node's firstChild!)
' ---------------------------------------------------------------------
If (oCurrNode.NodeType = 3) Then                                 ' 3 ... NODE_TEXT
  ' display pure text content (NODE_TEXT) of parent elements
    v(i, VALUEColumn) = oCurrNode.Text                           ' nodeValue of text node
  ' return
    listChildNodes = True
ElseIf oCurrNode.NodeType = 1 Then                                ' 1 ... NODE_ELEMENT
   ' --------------------------------------------------------------
   ' B.1 NODE_ELEMENT WITHOUT text node immediately below,
   '     a) e.g. <Details> followed by node element <NAME>,
   '        (i.e. FirstChild.NodeType must not be of type NODE_TEXT = 3)
   '     b) e.g. <College> node element without any child node
   '     Note: a text content (NODE_TEXT) actually is a child node(!) to an element node
   '           (see section A. getting the FirstChild of a NODE_ELEMENT)
   ' --------------------------------------------------------------
   ' a) display parent elements of other element nodes
     If oCurrNode.HasChildNodes Then
         If Not oCurrNode.FirstChild.NodeType = 3 Then             ' <>3 ... not a NODE_TEXT
            bDisplay = True
         End If
   ' b) always display empty node elements
     Else                                                           ' empty NODE_ELEMENT
            bDisplay = True
     End If
     If bDisplay Then
            v(i, NAMEColumn) = String(iLvl * 2, " ") & _
                               iLvl & " " & _
                               oCurrNode.nodename & getAtts(oCurrNode)
            i = i + 1
     End If

   ' --------------------------------------------------------------
   ' B.2 check child nodes
   ' --------------------------------------------------------------
     For Each oChildNode In oCurrNode.ChildNodes
      ' ~~~~~~~~~~~~~~~~~
      ' recursive call <<
      ' ~~~~~~~~~~~~~~~~~
        bDisplay = listChildNodes(oChildNode, v, i, iLvl + 1)

        If bDisplay Then
            v(i, NAMEColumn) = String(iLvl * 2, " ") & _
                               iLvl & " " & _
                               oCurrNode.nodename & getAtts(oCurrNode)
            i = i + 1
        End If
     Next oChildNode
   ' return
     listChildNodes = False

Else    ' just to demonstrate the use of other xml types as e.g. <!-- comments -->
     If oCurrNode.NodeType = 8 Then   ' 8 ... NODE_COMMENT
        v(i, VALUEColumn) = "<!-- " & oCurrNode.NodeValue & "-->"
        i = i + 1
     End If
   ' return
     listChildNodes = False
End If

End Function

'辅助函数getAtts()

上面函数调用的这个辅助函数返回一个字符串，枚举给定节点的所有属性名称和值，类似于XPath符号；代码可以很容易地适应您的需要。

Function getAtts(ByRef node As Object) As String
' Purpose: return attribute(s) string in brackets, e.g. '[@num="123"]'
' Note:    called by above function listChildNodes()
' Author:  T.M.
  Dim sAtts$, ii&
  If node.Attributes.Length > 0 Then
      ii = 0: sAtts = ""
      For ii = 0 To node.Attributes.Length - 1
        sAtts = sAtts & "[@" & node.Attributes.Item(ii).nodename & "=""" & node.Attributes.Item(ii).NodeValue & """]"
      Next ii
  End If
' return
  getAtts = sAtts
End Function