使用 VBA 从 XML 中获取属性名称答案

【问题标题】：Obtain attribute names from XML using VBA使用 VBA 从 XML 中获取属性名称
【发布时间】：2019-01-24 01:11:30
【问题描述】：

我需要使用 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。我需要从 XML 中获取属性名称num。

<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

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

【问题讨论】：

所以你已经告诉我们你想做什么了。您共享的代码不起作用怎么办？ Edit 您的帖子并包括预期结果、实际结果和任何错误消息。请访问help center 并阅读How to Ask 以了解如何有效地使用本网站。
更新问题
不清楚你在问什么。可能是XY problem。
添加了一个工作示例，如何使用 XMLDOM 通过递归调用将整个 XML 结构分配给 2-dim 数组，并可选择将其写入工作表。也可以查看建议发现 XSLT 方法的其他提示（参见许多帖子，例如 @Parfait 提供的帖子）。
@Raja - 编辑并改进了我的答案，展示了一种确定确切元素项计数或定义由调用函数 listChildNodes() 自动更正的估计数量的方法。此外，可以选择一个精确的节点来获取其结构而不是整个文件集。 - 您是否尝试过我的解决方案以便将其标记为已接受？

标签： excel xml vba xmldom

【解决方案1】：

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

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

[1] 使用 XMLDOM 方法和
[2] 可选择将其写回工作表。

放大提示：

我添加了这些 ► 结构化提示以提供比仅显示代码更多的帮助，因为我注意到其中许多点也会导致其他用户重复提问：

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

调用过程DisplayXML

提示： 在主函数执行ReDim（包括如果需要，自动转置）。尽管如此，我还是通过 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

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

提示：如果不想要level缩进或者枚举Level层次结构，可以很方便的适配下面的main函数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 开始。

如果项目计数器 i 超过当前数组的上限（UBound(v)，即在其第一维 = 项目计数），

Edit 20/8 2018 包括数组大小自动增加。 技术说明：由于 ReDim 在次要（此处为第一个）维度中是不可能的，因此需要将“行”（维度 1）更改为“列”（维度 2）的中间换位。

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

【讨论】：