Excel VBA – Nested Data in XML file

Looking for a little bit of help here. I have an XML file that I need to get a value from an item in the list and drop it in a spreadsheet. The “getting it in the spreadsheet” code is not listed here as I have that part working from a previous project that works.

Here is an example of the XML:

<Level1 Name="Top">
    <Level2 Name="First" id="1-0">
        <Level3 Name="First First" id="1-1" />
        <Level3 Name="Second First" id="1-2" />
        <Level3 Name="Third First" id="1-3" />
    </Level2>         **EDITED***
    <Level2 Name="Second" id="1-0">
        <Level3 Name="First Second" id="2-1" />
        <Level3 Name="Second Second" id="2-2" />
        <Level3 Name="Third Second" id="2-3" />
    </Level2>
</Level1>

I am attempting to retrieve the id from each Level3 for each Level2. I can’t quite get the Node List to cycle through. It keeps “skipping” the For.

Sub Stuff()
    Dim XMLFileName As String
    Dim oXMLFile As New MSXML2.DOMDocument60
    Dim XMLSNL1 As IXMLDOMNodeList               'XML Source...(NodeList/Node/Element)
    Dim XMLSE1 As IXMLDOMElement
    Dim XMLSN1 As IXMLDOMNode
    Dim XMLSNL2 As IXMLDOMNodeList
    Dim XMLSN2 As IXMLDOMElement
    Dim XMLSN2 As IXMLDOMNode
    Dim TempStr as String          'Using this to more easily watch (for me) the data

    oXMLFile.async = False
    oXMLFile.validateOnParse = False

    oXMLFile.Load (XMLFileName)    'I use the actual filename here. Verified it comes in

    Set XMLSNL1 = oXMLFile.SelectNodes("//Level1/Level2")
    Set XMLSNL2 = oXMLFile.SelectNodes("//Level1/Level2/Level3")
    
    For Each XMLSE1 In XMLSNL1
        TempStr = XMLSNL1.getAttribute(id)
    Next
End Sub

I do realize at this point I’m not going down to Level3 but I work progressively and trying to at least get data from Level2. Let me know if more info is needed and I’ll make edits here. Thank you in advance for your time.

Firstly, your XML code is not correct… First Level2 tag is not closed. It must look like:

<Level1 Name="Top">
    <Level2 Name="First" id="1-0">
        <Level3 Name="First First" id="1-1" />
        <Level3 Name="Second First" id="1-2" />
        <Level3 Name="Third First" id="1-3" />
    </Level2>
    <Level2 Name="Second" id="1-0">
        <Level3 Name="First Second" id="2-1" />
        <Level3 Name="Second Second" id="2-2" />
        <Level3 Name="Third Second" id="2-3" />
    </Level2>
</Level1>

It is good to test if the XML is correct (in code). So, it would be good to use .validateOnParse = True and then test if the file is (Not) loaded. Please, test the next adapted code:

Sub Stuff()
    Dim XMLFileName As String
    Dim oXMLFile As New MSXML2.DOMDocument60
    Dim XMLSNL1 As IXMLDOMNodeList
    Dim XMLSE1 As IXMLDOMElement
    Dim XMLSE2 As IXMLDOMElement
    Dim XMLSNL2 As IXMLDOMNodeList
    
    XMLFileName = ThisWorkbook.Path & "TesteXMLTestLevels.xml" 'use here your file path (if extracted from a local file)
    If Dir(XMLFileName) = "" Then MsgBox "Wrong file full name...": Exit Sub 'for local file
    
    With oXMLFile
        .async = False
        .validateOnParse = True 'if offer the possibility to check that XML is correct
        If Not .Load(XMLFileName) Then 'if not loaded (being incorrect) show the parse error 
                                       'description and number
           Debug.Print .parseError.reason, .parseError.ErrorCode: Exit Sub 'exist if not parsed
        End If

        Set XMLSNL1 = .SelectNodes("//Level1/Level2") 'set only a node list (since only Levell3 exists)
    End With

    Debug.Print XMLSNL1.Item(0).ParentNode.BaseName   'Level1
    For Each XMLSE1 In XMLSNL1
        Debug.Print , XMLSE1.BaseName & ": " & XMLSE1.getAttribute("Name") 'level2
        Set XMLSNL2 = XMLSE1.SelectNodes("Level3")
        For Each XMLSE2 In XMLSNL2
            Debug.Print , , XMLSE2.BaseName & ": " & XMLSE2.getAttribute("Name") 'level3
            Debug.Print , , , "Level3 ID = " & XMLSE2.getAttribute("id")
        Next XMLSE2
    Next
End Sub

The code below will write the required data into the columns A and B of the active sheet as seen in the screenshot below. Note that, i corrected an unclosed tag in the XML file, so use the one below for testing. Also, the XML file should be in the same folder with the Excel file. Code written with Excel 2010 64 Bit on Win 11 64 Bit. (Column B should be formatted as Text otherwise, Excel will try to write the data as Date).

<Level1 Name="Top">
    <Level2 Name="First" id="1-0">
        <Level3 Name="First First" id="1-1" />
        <Level3 Name="Second First" id="1-2" />
        <Level3 Name="Third First" id="1-3" />
    </Level2>
    <Level2 Name="Second" id="1-0">
        <Level3 Name="First Second" id="2-1" />
        <Level3 Name="Second Second" id="2-2" />
        <Level3 Name="Third Second" id="2-3" />
    </Level2>
</Level1>

Sub Test()
    Dim XDoc As Object, strURL As String
    Dim myList As Object, Num As Integer, i As Integer
    
    Set XDoc = CreateObject("MSXML2.DOMDocument")
    XDoc.async = False
    XDoc.validateOnParse = False
    
    strURL = ThisWorkbook.Path & "/Test.xml"
    XDoc.Load strURL
     
    Set myList = XDoc.SelectNodes("//Level2/Level3")
        
    If myList.Length = 0 Then GoTo SafeExit:
    
    Num = myList.Length - 1
    
    For i = 0 To Num
        Cells(i + 1, 1) = myList(i).getAttribute("Name")
        Cells(i + 1, 2) = myList(i).getAttribute("id")
    Next
    
SafeExit:
    Set myList = Nothing
    Set XDoc = Nothing
End Sub

NOTE:

Instead of the following line;

Set myList = XDoc.SelectNodes("//Level2/Level3")

you can use this, as well;

Set myList = XDoc.getElementsByTagname("Level3")

If you want the nested level3 for each level2:

Sub Stuff()
    
    Dim oXMLFile As New MSXML2.DOMDocument60
    Dim L2Nodes As IXMLDOMNodeList, el2 As Object
    Dim L3Nodes As IXMLDOMNodeList, el3 As Object
    
    oXMLFile.async = False
    oXMLFile.validateOnParse = True
    oXMLFile.LoadXML [A4].Value
    Debug.Print oXMLFile.parseError.reason

    Set L2Nodes = oXMLFile.SelectNodes("//Level1/Level2")
    Debug.Print L2Nodes.Length
    
    For Each el2 In L2Nodes
        Debug.Print el2.getAttribute("Name")
        Set L3Nodes = el2.SelectNodes("Level3")'<< Get child Level3 nodes
        For Each el3 In L3Nodes
            Debug.Print , el3.getAttribute("id")
        Next el3
    Next
    
End Sub

Alternative via FilterXML()

Since Excel has offered a “FilterXML()” function since 2016, I was tempted to exploit this possibility, taking some restrictions into account, and to demonstrate it via Range.Evaluation.

You have to know that VBA does not provide node lists depending on the XPath entered, but rather reads out the real values as a 2-dim array (if there are multiple hits).

a) Name attribute
To obtain the Name attributes, for example, all you need to do is enter a well-formed XML string and a simple XPath expression in the following formula: =FILTERXML(A4, "//Level3/@Name")

b) id attribute
However, reading out values is significantly more complex – in the above case of id attributes such as 1-1, which Excel interprets as date or numeric value. Here I had to first change the “-” separator temporarily via Replace(), and then put it back after reading the FilterXML, but this time as a text value.

Caveat: if you want to write the arrays back to sheet you need a text formatting of the receiving column, otherwise you would get (also) numeric values again (see section d).

Sub EvalXMLFilter()
    Dim Pattern: Pattern = "FilterXML(A4,""//Level3/@"")"
    Dim expr As String
    With Sheet1                 ' << change as needed
    'a) get names
        Dim names
        expr = Replace(Pattern, "@", "@Name")
        '~~>FILTERXML(A4,"//Level3/@Name")
        names = .Evaluate(expr)
    'b) get ids
        Dim ids
        expr = Replace(Pattern, "FilterXML(A4,", "Substitute(FILTERXML(Substitute(A4,""-"",""$""),")
        expr = Replace(expr, "@", "@id" & """),""$"",""-")
        '~~>SUBSTITUTE(FILTERXML(SUBSTITUTE(A4,"-","$"),"//Level3/@id"),"$","-")
        ids = .Evaluate(expr)
    'c) optional - write to sheet (e.g. cols K:L)
        .Range("K4").resize(ubound(names),1) = names
        .Columns("L").numberformat = "@"
        .Range("L4").resize(ubound(ids),1) = ids
    End With
    
End Sub

Filed under: Kiến thức lập trình - @ 02:52

Thẻ: excelvba

Thiết kế website giá rẻ

Danh mục

Excel VBA – Nested Data in XML file