使用VBA从XML获取唯一属性

我有下面的XML。我需要从XML中获取唯一的属性和标记。有人能指导我从XML中获取唯一的属性吗？谢谢

<Elements>
<Details>
    <Name>ABCD</Name>
    <Address>1D23ABC</Address>
</Details>  
<Dept num = "12S3" >
    <Deptname>ITS</Deptname>
    <ID>A12S3</ID>
    <ID1>A12W3</ID1>
</Dept> 
    <Dept num = "123" >
    <Deptname>IT1</Deptname>
    <ID>A1231</ID>
    <ID1>A1213</ID1>
</Dept> 

下面是我正在使用的VBA代码：

设置mainnode=oXMLFile.SelectNodes//Elements 对于mainnode中的每个节点 将儿童视为对象 i=0 对于node.ChildNodes中的每个子节点 工作表Sheets1.Range C&i+1.Value=child.BaseName 以暗淡的儿童为对象 对于child.ChildNodes中的每个kiddo Debug.Print kiddo.BaseName 工作表Sheets1.i+1。值= kiddo.BaseName i=i+1 下一个孩子 下一个孩子 下一节点 电流输出：

Elements
Details    Name
           Address

Dept       Num
           Deptname
           ID
           ID1
Dept       Num
           Deptname
           ID
           ID1

第1版正则表达式： 通常不建议使用正则表达式来处理XML/HTML

选项显式 公共子测试 Dim xmlDoc作为新的MSXML2.DOMDocument60 设置xmlDoc=New MSXML2.DOMDocument60 加载C:\Users\User\Desktop\Test.xml Dim arr作为字符串，dict作为对象，key作为变量，i作为长 arr=SplitGetTagsxmlDoc.XML，：Set dict=CreateObjectScripting.Dictionary 对于i=LBoundarr到UBoundarr DICTREPLACEARRI，Chr$60，vbNullString，Chr$62，vbNullString=1 接下来我 ActiveSheet.RangeA1.Resizedict.Count，1=Application.WorksheetFunction.Transposedict.keys 端接头 公共函数GetTagsByVal xmlString作为字符串变量 Dim arr As String，i As Long，匹配As Object，re As Object Set re=CreateObjectVBScript.RegExp 带re .Global=True .MultiLine=True .IgnoreCase=False .模式= 如果.testxmlString 设置匹配项=.ExecutexmlString 将arr0重拨到匹配项。计数-1 对于i=LBoundarr到UBoundarr arri=matchesi 接下来我 其他的 arri=xmlString 如果结束 GetTags=Joinarr， 以 端函数 正则表达式

输出：

您可以删除/忽略覆盖文档类型的初始标记

参考资料：

工具>参考>Microsoft XML您的版本，例如6.0

第2版遍历树结构： 更健壮的解决方案，使您的现有代码能够使用字典字典，从而可以轻松写出树结构

Option Explicit
Public Sub testing()
    Dim xmlDoc As New MSXML2.DOMDocument60, mainNode As Object, Node As Object, dict As Object, r As Long
    Set xmlDoc = New MSXML2.DOMDocument60
    xmlDoc.Load "C:\Users\User\Desktop\Test.xml"
    Set mainNode = xmlDoc.SelectNodes("//Elements"): Set dict = CreateObject("Scripting.Dictionary")

    [B1] = xmlDoc.DocumentElement.nodeName

    For Each Node In mainNode
        Dim child As Object
        For Each child In Node.ChildNodes
            If Not dict.exists(child.BaseName) Then
                dict.Add child.BaseName, CreateObject("Scripting.Dictionary")
            End If
            Dim kiddo As Object
            For Each kiddo In child.ChildNodes
                If Not dict(child.BaseName).exists(kiddo.BaseName) Then
                    dict(child.BaseName).Add kiddo.BaseName, 1
                End If
            Next kiddo
        Next child
    Next Node
    r = 0
    Dim key1 As Variant, key2 As Variant
    For Each key1 In dict.keys
        Worksheets("sheet1").Range("C" & r + 1) = key1
        For Each key2 In dict(key1).keys
             Worksheets("sheet1").Range("D" & r + 1).Value = key2
             r = r + 1
        Next
    Next
End Sub

---

该XML示例中唯一的实际属性是num——您列出的所有其他属性都是元素tags@TimWilliams-我道歉。我需要上述XML中所有唯一的标记和属性。@QHarr-我只需要唯一的名称，而不考虑值。我不关心这些标记中的值是什么。你应该通过XSLT来获得它，这会更快、更有效。regex截图来自哪个工具？ThanksDept num=1253不是每个操作的预期输出的一部分，它应该是Dept和num，并用分隔符分隔。也不会在每个操作的树视图中输出。另外，值得注意的是，虽然这在这种特殊情况下可能会起作用，但使用RegEx解析XML/HTML/etc通常不被认为是最佳实践：@DavidZemens在最佳实践位中同意。一般来说，这是一种非常糟糕和不可靠的做法！关于它是否选择了正确的位：我认为OP的问题/评论有点混乱。我只需要不考虑值的唯一名称。我同意最新的评论。不管怎样，它们现在可能永远消失了：-@QHarr-谢谢你的密码。它适用于给定的sampel xml，但是当我为类似的其他xml运行代码时，我得到了“类型不匹配”。是否有理由找出哪个字段不匹配？我正在寻找一个树结构来识别父节点和子节点，并获得它们之间的唯一值。。如果有一种方法可以在不影响树结构的情况下识别唯一值，请告诉我。谢谢您：

Option Explicit
Public Sub testing()
    Dim xmlDoc As New MSXML2.DOMDocument60, mainNode As Object, Node As Object, dict As Object, r As Long
    Set xmlDoc = New MSXML2.DOMDocument60
    xmlDoc.Load "C:\Users\User\Desktop\Test.xml"
    Set mainNode = xmlDoc.SelectNodes("//Elements"): Set dict = CreateObject("Scripting.Dictionary")

    [B1] = xmlDoc.DocumentElement.nodeName

    For Each Node In mainNode
        Dim child As Object
        For Each child In Node.ChildNodes
            If Not dict.exists(child.BaseName) Then
                dict.Add child.BaseName, CreateObject("Scripting.Dictionary")
            End If
            Dim kiddo As Object
            For Each kiddo In child.ChildNodes
                If Not dict(child.BaseName).exists(kiddo.BaseName) Then
                    dict(child.BaseName).Add kiddo.BaseName, 1
                End If
            Next kiddo
        Next child
    Next Node
    r = 0
    Dim key1 As Variant, key2 As Variant
    For Each key1 In dict.keys
        Worksheets("sheet1").Range("C" & r + 1) = key1
        For Each key2 In dict(key1).keys
             Worksheets("sheet1").Range("D" & r + 1).Value = key2
             r = r + 1
        Next
    Next
End Sub