VBA - Display each node and its value from XML

Question

I have a simple XML as below and I need to display name of each and every node and its value. No element would have any 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 challenge here is there may be some element which might have sub-element in its own e.g. Address So the code needs to have a recursive function.

Also the elements which don't have any text like Address4(it only has sub-elements) should not be displayed. Also the elements like Province should not be displayed.

I tried following code but not working..

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

"it is not working" - what is the error you are getting? What are you expecting as output, and what are you seeing? — Floris, Feb 14 '13 at 14:18
@Tejas, Have you concidered using Xpath to retrieve all Elements in the node and then just loop through the NodeList and retrieve the info you need? — CaBieberach, Feb 14 '13 at 15:25
@Floris: The output should be two msgboxes here. First should say, "Address: Address goes here" and 2nd one should say "Home: 123". (As per the updated XML by me) Can you please help in achieving that? — TechGeek, Feb 14 '13 at 18:23
@CaBieberach: Using Xpath when I say, Set All_nodes = xmlDoc.SelectNodes("//*") it also returns **Contact** and **PhoneList** nodes which I don't want because they don't have any Text. They just have sub-elements. Any workaround please? — TechGeek, Feb 14 '13 at 18:24
`Microsoft.XMLDOM` almost certainly is wrong. Try `MSXML2.DOMDocument60` instead — barrowc, Feb 15 '13 at 02:14
Various nodes like Address4 and Province in the sample data have no text content. Should they be returned or not? — barrowc, Feb 15 '13 at 13:41
@barrowc: Only node with a text should be displayed. So Address4 should not be. Your help wold be highly appreciated as I need this on urgent basis. Thanks. — TechGeek, Feb 15 '13 at 14:16

Floris · Accepted Answer · 2013-02-15T15:52:38.060

Assuming your XML is in cell "A2", the first problem is that your line

  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 process.

EDITs 1&2

The other problem is that a node-inside-a-node will not give the right output. To address that, you need to change your List_ChildNodes function slightly. The first modification worked for the examples you had provided, but not for the later one, which does not get parsed correctly with the code I provided earlier. So I added an error trap which ensures that even this XML is read (what I believe to be) correctly. The trick of using On Error Resume Next is essentially the VBA equivalent of a Try ... Catch statement (except that the "catch" is: "set L to zero if there's an error. We're actually setting L to zero first, and don't overwrite that on error. Same thing, different order. One of those tricks they don't teach 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 have tested the latest version with the bigger XML fragment that you provided, and it appeared to parse without a glitch. I wasn't going to go through it line by line to check...

Thanks for the answer. But as per the updated XML it not displaying **Home: 123** That's the issue I have been facing. Can you please have a workaround for the same? — TechGeek, Feb 14 '13 at 18:26
I have observed the same thing that you have. I have made an edit to the code - now it works for me. Please confirm if it fixes the problem for you. — Floris, Feb 14 '13 at 20:37
Thanks but still it's not perfect. See the updated XML. I have added a Dummy self-closing node in it. Code is not working fine on it. — TechGeek, Feb 15 '13 at 03:05
I answered your question twice now and then you change the problem... May take another look in the morning but that is not really how this works. — Floris, Feb 15 '13 at 03:08
Very sorry for that. I have updated the final XML now. There won't be any change further. Can you please help me out to **read all sub-nodes of RequestBody Node?** I really appreciate your help till now. I found http://www.java2s.com/Code/Php/XML/TraversingaTreeofXMLNodesUsingRecursion.htm helpful but now able to make use of it correctly. — TechGeek, Feb 15 '13 at 07:46

score 0 · Answer 2 · answered Feb 14 '13 at 16:14

0

Excel has a built in .xml importer. You don't need to write your own(unless you're trying to do something unusual). http://office.microsoft.com/en-us/excel-help/import-xml-data-HP010206405.aspx#BMimport_an_xml_file_as_an_xml_list_wit

answered Feb 14 '13 at 16:14

Stepan1010

3,136
1
16
21

score 0 · Answer 3 · answered Feb 16 '13 at 02:28

Try this version.

Notes:

uses MSXML2.DOMDocument.6.0 rather than the very outdated Microsoft.XMLDOM
uses Option Explicit and all variables are declared with an appropriate type
loads from a file for my convenience but you can obviously change it back to read from a Range
avoids the usual XPath default namespace issue in MSXML2 by declaring a prefix for the default namespace and using that prefix in any XPath queries
make text nodes responsible for printing their own text
use a Function rather than a Sub so that we know when to print out 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

VBA - Display each node and its value from XML

3 Answers3