xml - VBA - 从 XML 显示每个节点及其值

Question

我有一个简单的 XML，如下所示，我需要显示每个节点的名称及其值。任何元素都不会有任何属性。

<?xml version="1.0" encoding="UTF-8"?>
<ResponseEnvelope xmlns="http://www.nwabcdfdfd.com/messagin" xmlns:xsd="http://www.w3.org/2001/XMLSchema" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance">
   <ResponseHeader>
      <RequestId>directv_99e0857d-abf3-461c-913e-3ab59c6b5ef6</RequestId>
      <ResponseId>1162969</ResponseId>
      <MessageVersion>1.10</MessageVersion>
      <RequestTimestamp>2013-02-12T17:26:28.172Z</RequestTimestamp>
      <ResponseTimestamp>2013-02-12T17:26:50.409Z</ResponseTimestamp>
      <SenderId>CarePortal2</SenderId>
      <ProgramName />
      <TestProdFlag>P</TestProdFlag>
      <ResultCode>9</ResultCode>
      <Locale>en_US</Locale>
      <Errors>
         <Error>
            <ErrorCode>9</ErrorCode>
            <ErrorNumber>90001</ErrorNumber>
            <ErrorMessage>System error occurred</ErrorMessage>
            <ErrorFieldId />
         </Error>
      </Errors>
   </ResponseHeader>
   <ResponseBody xsi:type="CPSingleSignOnResponse">
      <PortalUserID>45497</PortalUserID>
      <PartyID>1858186</PartyID>
      <WarrantyItemName>DTV ABC WOLE HE P</WarrantyItemName>
      <WarrantyInventoryItemId>138677</WarrantyInventoryItemId>
      <ClientWarrantySku>202</ClientWarrantySku>
      <ClientWarrantyDescription>DV Plan</ClientWarrantyDescription>
      <ContractNumber>4003564</ContractNumber>
      <IsPortalUserCreated>N</IsPortalUserCreated>
      <IsPartyCreated>N</IsPartyCreated>
      <IsContractUpdated>N</IsContractUpdated>
      <IsFootPrintUpdated>N</IsFootPrintUpdated>
      <Customer>
         <PartyId>185812386</PartyId>
         <Salutation />
         <FirstName>Tejas</FirstName>
         <LastName>Tanna</LastName>
         <AddressList>
            <Address>
               <PartySiteId>3617490</PartySiteId>
               <Type>BILTO</Type>
               <Address1>CASCADES</Address1>
               <Address2>202</Address2>
               <Address3>RIDGE HEAVEN</Address3>
               <Address4 />
               <City>STERLING</City>
               <State>VA</State>
               <PostalCode>20165</PostalCode>
               <County>LOUDOUN</County>
               <Province />
               <Country>US</Country>
               <Urbanization />
               <AddressStyle>US</AddressStyle>
            </Address>
            <Address>
               <PartySiteId>3613791</PartySiteId>
               <Type>SHIP_T</Type>
               <Address1>CASADS</Address1>
               <Address2>22</Address2>
               <Address3>RIE HEEN</Address3>
               <Address4 />
               <City>STELI</City>
               <State>VA</State>
               <PostalCode>2065</PostalCode>
               <County>LOUUN</County>
               <Province />
               <Country>US</Country>
               <Urbanization />
               <AddressStyle>US</AddressStyle>
            </Address>
         </AddressList>
         <PhoneList>
            <Phone>
               <ContactPointId>2371717</ContactPointId>
               <Type>HOME PNE</Type>
               <PhoneNumber>51-62-7464</PhoneNumber>
               <Country>1</Country>
               <PrimaryFlag>Y</PrimaryFlag>
            </Phone>
         </PhoneList>
         <EmailList>
            <Email>
               <ContactPointId>237516</ContactPointId>
               <EmailAddress>a.abc@abc.com</EmailAddress>
               <PrimaryFlag>Y</PrimaryFlag>
            </Email>
         </EmailList>
      </Customer>
   </ResponseBody>
</ResponseEnvelope>

这里唯一的挑战是可能有一些元素可能在它自己的子元素中，例如地址所以代码需要有一个递归函数。

此外，不应显示没有像Address4 这样的文本的元素（它只有子元素）。此外，不应显示省等元素。

我尝试了以下代码但没有工作..

Sub Driver()
    Range("4:" & Rows.Count).ClearContents
    Set xmlDoc = CreateObject("Microsoft.XMLDOM")

    i = 4
    xmlDoc.LoadXML (Range("A2"))
    Set oParentNode = xmlDoc.DocumentElement.SelectNodes("ResponseBody")(0)
    Call List_ChildNodes(oParentNode, i, "A", "B")
End Sub

Sub List_ChildNodes(oParentNode, i, NameColumn, ValueColumn)
    For Each oChildNode In oParentNode.ChildNodes
        If oChildNode.ChildNodes.Length > 1 Then
            Call List_ChildNodes(oChildNode, i, NameColumn, ValueColumn)
        Else
            Cells(i, NameColumn) = oChildNode.tagname
            Cells(i, ValueColumn) = oChildNode.Text
            i = i + 1
        End If
    Next
End Sub

Answer 1

假设您的 XML 在单元格“A2”中，第一个问题是您的行

  Set oParentNode = xmlDoc.DocumentElement.SelectNodes("ResponseBody")(0)

退货nothing。将其更改为

  Set oParentNode = xmlDoc.DocumentElement

并且代码至少会有一些东西要处理。

编辑 1&2

另一个问题是 node-inside-a-node 不会给出正确的输出。为了解决这个问题，你需要List_ChildNodes稍微改变你的功能。第一个修改适用于您提供的示例，但不适用于后一个，因为我之前提供的代码无法正确解析它。所以我添加了一个错误陷阱，以确保即使这个 XML 也被正确读取（我相信是这样）。使用的技巧On Error Resume Next本质上是一个Try ... Catch语句的 VBA 等效项（除了“catch”是：“如果有错误，请将 L 设置为零。我们实际上是先将 L 设置为零，并且不要在错误时覆盖它。同样的事情，不同的顺序。他们在学校不教的那些技巧之一！）

Sub List_ChildNodes(oParentNode, i, NameColumn, ValueColumn)
Dim L As Integer
    For Each oChildNode In oParentNode.ChildNodes
        L = 0
        Err.Clear
        On Error Resume Next
        L = oChildNode.ChildNodes(0).ChildNodes.Length
        If L > 0 Then
            Call List_ChildNodes(oChildNode, i, NameColumn, ValueColumn)
        Else
            If Not oChildNode.Text = "" Then
                Cells(i, NameColumn) = oChildNode.tagName
                Cells(i, ValueColumn) = oChildNode.Text
                i = i + 1
            End If
        End If
    Next
End Sub

我已经使用您提供的更大的 XML 片段测试了最新版本，它似乎可以毫无故障地解析。我不打算逐行检查...

Answer 2

Excel 有一个内置的 .xml 导入器。你不需要自己写（除非你想做一些不寻常的事情）。http://office.microsoft.com/en-us/excel-help/import-xml-data-HP010206405.aspx#BMimport_an_xml_file_as_an_xml_list_wit

Answer 3

试试这个版本。

笔记：

• 使用 MSXML2.DOMDocument.6.0 而不是非常过时的 Microsoft.XMLDOM
• 使用 Option Explicit 并且所有变量都用适当的类型声明
• 为方便起见从文件加载，但您显然可以将其更改回从范围读取
• 通过声明默认命名空间的前缀并在任何 XPath 查询中使用该前缀，避免了 MSXML2 中常见的 XPath 默认命名空间问题
• 让文本节点负责打印自己的文本
• 使用 Function 而不是 Sub 以便我们知道何时打印出节点名称

这是代码：

Option Explicit

Sub Driver()

Dim i As Long
Dim xmlDoc As Object
Dim oParentNode As Object
Dim bDiscard As Boolean

Range("4:" & Rows.Count).ClearContents
i = 4

Set xmlDoc = CreateObject("MSXML2.DOMDocument.6.0")
xmlDoc.Load "foo.xml"
xmlDoc.setProperty "SelectionNamespaces", "xmlns:r='http://www.nwabcdfdfd.com/messagin'"

Set oParentNode = xmlDoc.selectSingleNode("//r:ResponseBody")
bDiscard = listChildNodes(oParentNode, i, "A", "B")

End Sub

Function listChildNodes(oParentNode As Object, i As Long, NameColumn As String, ValueColumn As String) As Boolean

Dim oChildNode As Object
Dim bResult As Boolean

If (oParentNode.nodeType = 3) Then 'i.e. DOMNodeType.NODE_TEXT
    Cells(i, ValueColumn).Value = oParentNode.Text
    listChildNodes = True
Else
    For Each oChildNode In oParentNode.childNodes
        bResult = listChildNodes(oChildNode, i, NameColumn, ValueColumn)

        If (bResult) Then
            Cells(i, NameColumn).Value = oParentNode.nodeName
            i = i + 1
        End If
    Next oChildNode
    listChildNodes = False
End If

End Function