VBA-显示XML中的每个节点及其值
我有一个简单的XML,如下所示,我需要显示每个节点的名称及其值。没有任何元素具有任何属性VBA-显示XML中的每个节点及其值,xml,vba,excel,recursion,xmldom,Xml,Vba,Excel,Recursion,Xmldom,我有一个简单的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-instanc
<?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>
假设XML位于单元格“A2”中,第一个问题是
Set oParentNode = xmlDoc.DocumentElement.SelectNodes("ResponseBody")(0)
不返回任何内容。换成
Set oParentNode = xmlDoc.DocumentElement
代码至少会有一些东西需要处理
编辑1和2
另一个问题是节点内部的节点不会给出正确的输出。要解决这个问题,您需要稍微更改List\u ChildNodes
函数。第一次修改适用于您提供的示例,但不适用于后面的示例,后者无法使用我前面提供的代码正确解析。因此,我添加了一个错误陷阱,确保即使是这个XML也能被正确读取(我认为是这样的)。在错误恢复下一步时使用的技巧本质上是与Try相同的VBA。。。Catch
语句(除了“Catch”是:“如果出现错误,将L设置为零。我们实际上是先将L设置为零,然后在出现错误时不要覆盖它。相同的事情,不同的顺序。其中一个技巧他们在学校里不教!)
我已经用您提供的更大的XML片段测试了最新版本,它的解析似乎没有任何问题。我不会逐行检查它来检查…Excel有一个内置的.XML导入器。您不需要编写自己的导入器(除非您尝试做一些不寻常的事情)。尝试此版本
注:
- 使用MSXML2.DOMDocument.6.0,而不是非常过时的Microsoft.XMLDOM
- 使用Option Explicit,所有变量都使用适当的类型声明
- 为方便起见,从文件加载,但显然可以将其更改回从某个范围读取
- 通过为默认名称空间声明前缀并在任何XPath查询中使用该前缀,避免了MSXML2中常见的XPath默认名称空间问题
- 使文本节点负责打印自己的文本
- 使用函数而不是子函数,以便知道何时打印节点名称
代码如下:
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
“它不工作”-您得到的错误是什么?您期望输出是什么,您看到的是什么?@Tejas,您是否已使用Xpath检索节点中的所有元素,然后通过节点列表循环检索您需要的信息?@Floris:这里的输出应该是两个MsgBox。第一个应该是,”地址:Address在这里”,第二个应该是“Home:123”。(根据我更新的XML)你能帮我实现吗?@CaBieberach:当我说时使用Xpath,设置All_nodes=xmlDoc.SelectNodes(“//*”)它还返回我不想要的联系人和电话列表节点,因为它们没有任何文本。它们只有子元素。有什么解决方法吗?Microsoft.XMLDOM
几乎肯定是错误的。请尝试MSXML2.DOMDocument60
代替。谢谢你的回答。但是根据更新的XML,它没有显示Home:123,这是问题所在我一直在面对。你能为同样的问题找到一个解决方法吗?我观察到了与你相同的事情。我已经对代码进行了编辑-现在它对我有效。请确认它是否为你解决了问题。谢谢,但它仍然不完美。请参阅更新的XML。我在其中添加了一个虚拟的自动关闭节点。代码在它上工作不正常。我回答我们现在问了你两次问题,然后你改变了问题…明天早上可能会再看一看,但这不是真正的工作方式。非常抱歉。我现在已经更新了最终的XML。不会有任何进一步的更改。你能帮我阅读RequestBody节点的所有子节点吗?我真的非常感谢你的帮助。我发现有帮助,但现在能够正确使用它。
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
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