VBA - display each node and its value from XML
I have a simple XML as shown below and I need to display the name of each node and its value. No element has an attribute.
<?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>
Only call here - it could be some kind of element, which can have a sub-element in its own, for example. Address Thus, the code must have a recursive function.
Also shouldn't display items that don't have any text, like Address4 (it only has sub-items) . Also, items such as Province should not be displayed .
I tried the following code but didn't work.
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
source to share
Assuming your XML is in cell "A2" the first problem is that your string
Set oParentNode = xmlDoc.DocumentElement.SelectNodes("ResponseBody")(0)
Returns nothing
. Change it to
Set oParentNode = xmlDoc.DocumentElement
and the code will at least have something to handle.
EDITORS 1 & 2
Another problem is that node-inside-a-node won't give correct output. To fix this problem, you need to change your function slightly List_ChildNodes
. The first modification worked on the examples you provided, but not for the later version, which doesn't get parsed correctly with the code I previously provided. So I added an error trap that makes sure that even this XML is read correctly (which I believe). The use trick On Error Resume Next
is essentially the VBA equivalent of the operator Try ... Catch
(except that "catch": "set L to zero if there is an error. In fact, we actually set L to zero, t overwrite that by mistake. Same, different order. One one of those tricks they don't learn in school!)
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
I tested the latest version with the large XML snippet you provided and it seemed to parse without glitch. I wasn't going to go across the line to check ...
source to share
Excel has a built-in .xml importer. You don't need to write your own (unless you're trying to do something fancy). http://office.microsoft.com/en-us/excel-help/import-xml-data-HP010206405.aspx#BMimport_an_xml_file_as_an_xml_list_wit
source to share
Try this version.
Notes:
- uses MSXML2.DOMDocument.6.0 and not the very deprecated Microsoft.XMLDOM
- uses Option Explicit and all variables are declared with the appropriate type
- loads from file for my convenience, but you can obviously change it to read from range
- avoids the usual problem of the default XPath namespace in MSXML2 by declaring a prefix for the default namespace and using that prefix in any XPath queries
- create text nodes responsible for printing your own text.
- use a function, not a Sub so that we know when to print the node name
Here is the code:
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
source to share