Excel VBA XML : Selecting a given tag value in a loop when nodes have attributes

Question

I browsed a lot of different solutions and tried several code lines but couldn't succeed with my example. I'm trying to get the text value (that's ok) of XML nodes, but remain stucked with the node attributes.

Here is my XML:

<MyList>

  <Entry Id="33">
    <Category>
      <Mycategory Style="One">
        <Rule Id="37">
          <Text>xxx123</Text>
        </Rule>  
        <Rule Id="476">
          <Text>123</Text>
        </Rule>  
      </Mycategory>

      <Mycategory Style="Two">
        <Rule Id="3756">
          <Text>xxx456</Text>
        </Rule>
        <Rule Id="734">
          <Text>456</Text>
        </Rule>
      </Mycategory>
    </Category>

  <Entry Id="821">
    <Category>
      <Mycategory Style="One">
        <Rule Id="538">
          <Text>xxxaaa</Text>
        </Rule>
        <Rule Id="366">
          <Text>aaa</Text>
        </Rule>    
      </Mycategory>

      <Mycategory Style="Two">
        <Rule Id="894">
          <Text>xxxbbb</Text>
        </Rule>
        <Rule Id="921">
          <Text>bbb</Text>
        </Rule>
      </Mycategory>
    </Category>

(etc. until the end of the XML)

I want the following Excel with VBA:

Style One | Style Two
xxx123 | xxx456
xxxaaa | xxxbbb

In extenso: only the text value (beginning with 'xxx') of the first '<'Rule> node. The second '<'Rule> node can be ignored.

All ID="" values are random.

My VBA code:

Sub Parsing()

Dim mainWorkBook As Workbook
Dim XMLFileName, Sheet As String
Dim nodeList As IXMLDOMNodeList

Set mainWorkBook = Workbooks("MyExcel.xlsm")
Set oXMLFile = CreateObject("Microsoft.XMLDOM")

XMLFileName = "C:\MyData.xml"
Sheet = "Sheet1"

oXMLFile.Load (XMLFileName)
Set StyleOne_Nodes = oXMLFile.SelectSingleNode("/MyList/Entry/Category/Mycategory[@name='One']/Rule/Text").Text
Set StyleTwo_Nodes = oXMLFile.SelectSingleNode("/MyList/Entry/Category/Mycategory[@name='Two']/Rule/Text").Text

For i = 0 To (StyleOne_Nodes.Length - 1)
    mainWorkBook.Sheets(Sheet).Range("A" & i + 2).Value = StyleOne_Nodes(i).NodeValue
    mainWorkBook.Sheets(Sheet).Range("B" & i + 2).Value = StyleTwo_Nodes(i).NodeValue
Next

End Sub

The code fails on SelectSingleNode. I have tried different ways (SelectNodes, SelectSingleNode, getElementsByTagName) but couldn't get my text values (e.g. xxx123 and xxx456) in the excel cells.
Also, looping on the right '<'Rule> is unclear.
How can I get only the '<'Text> value of the first '<'Rule> only (with 'xxx'; ignoring the second '<'Rule>), loop after loop (= '<'Entry> after '<'Entry>)?

Thanks for you help in advance.

Answer 1

Ignoring the fact the sample XML is invalid, something like the following is one way to solve the problem. This will group by Style:

Sub Parsing()
   Dim XMLFileName As String
   Dim oXMLFile As DOMDocument60
   Dim StyleOne_Nodes As IXMLDOMNodeList
   Dim StyleTwo_Nodes As IXMLDOMNodeList
   Dim n As IXMLDOMNode
   Dim c As IXMLDOMNode

   XMLFileName = "C:\temp\mydata.xml"
   Set oXMLFile = New DOMDocument60
   oXMLFile.Load XMLFileName

   Set StyleOne_Nodes = oXMLFile.selectNodes("/MyList/Entry/Category/Mycategory[@Style='One']")
   Set StyleTwo_Nodes = oXMLFile.selectNodes("/MyList/Entry/Category/Mycategory[@Style='Two']")

   If Not StyleOne_Nodes Is Nothing Then
      For Each n In StyleOne_Nodes
         Set c = n.selectSingleNode("Rule/Text")
         Debug.Print c.Text
      Next
   End If

   If Not StyleTwo_Nodes Is Nothing Then
      For Each n In StyleTwo_Nodes
         Set c = n.selectSingleNode("Rule/Text")
         Debug.Print c.Text
      Next
   End If
End Sub

For simplicity, I focused solely upon reading the XML file, so I stripped out all of the excel code. It should be a simple matter for you to put it back in.

EDIT:

Based on a further request from the OP and for clarity, I'm presenting QHarr's original logic. This will print row by row:

Sub Parsing2()
   Dim XMLFileName As String
   Dim oXMLFile As DOMDocument60
   Dim All_Nodes As IXMLDOMNodeList
   Dim n As IXMLDOMNode

   XMLFileName = "C:\temp\mydata.xml"
   Set oXMLFile = New DOMDocument60
   oXMLFile.Load XMLFileName

   Set All_Nodes = oXMLFile.selectNodes("//Mycategory/*[1]/Text")

   If Not All_Nodes Is Nothing Then
      For Each n In All_Nodes
         Debug.Print n.Text
      Next
   End If
End Sub

Answer 2

I would expect an xpath similar to

//Mycategory/*[1]/Text

We can separate out the styles if required by using:

//Mycategory[@Style='One']/*[1]/Text

And

//Mycategory[@Style='Two']/*[1]/Text

My version of XML corrected at end. It produces the expected node text.

Option Explicit
Public Sub test()
    Dim xmlDoc As Object
    Set xmlDoc = CreateObject("MSXML2.DOMDocument")
    With xmlDoc
        .validateOnParse = True
        .setProperty "SelectionLanguage", "XPath"
        .async = False

        If Not .Load("C:\Users\User\Desktop\Test.xml") Then
            Err.Raise .parseError.ErrorCode, , .parseError.reason
        End If
    End With
    Dim node As IXMLDOMElement
    '    For Each node In xmlDoc.SelectNodes("//Mycategory/*[1]/Text")
    '        Debug.Print node.Text
    '    Next
    For Each node In xmlDoc.SelectNodes("//Mycategory[@Style='One']/*[1]/Text")
       Debug.Print node.Text
    Next
    For Each node In xmlDoc.SelectNodes("//Mycategory[@Style='Two']/*[1]/Text")
        Debug.Print node.Text
    Next
End Sub

---

Edit to print style value before each group:

Option Explicit
Public Sub test()
    Dim xmlDoc As Object
    Set xmlDoc = CreateObject("MSXML2.DOMDocument")
    With xmlDoc
        .validateOnParse = True
        .setProperty "SelectionLanguage", "XPath"
        .async = False

        If Not .Load("C:\Users\User\Desktop\Test.xml") Then
            Err.Raise .parseError.ErrorCode, , .parseError.reason
        End If
    End With
    Dim node As Object, i As Long, xpath As Variant, j As Long
    For Each xpath In Array("//Mycategory[@Style='One']/*[1]/Text", "//Mycategory[@Style='Two']/*[1]/Text")
        j = 0
        For Each node In xmlDoc.SelectNodes(xpath)
            For i = 0 To node.ParentNode.ParentNode.Attributes.Length - 1
                If node.ParentNode.ParentNode.Attributes(i).nodeName = "Style" And j = 0 Then
                   Debug.Print node.ParentNode.ParentNode.Attributes(i).nodeName & Chr$(32) & node.ParentNode.ParentNode.Attributes(i).NodeValue
                End If
            Next
            Debug.Print node.Text
            j = j + 1
        Next
    Next
End Sub

---

With valid xml structure:

<MyList>
    <Entry Id="33">
        <Category>
            <Mycategory Style="One">
                <Rule Id="37">
                    <Text>xxx123</Text>
                </Rule>
                <Rule Id="476">
                    <Text>123</Text>
                </Rule>
            </Mycategory>
            <Mycategory Style="Two">
                <Rule Id="3756">
                    <Text>xxx456</Text>
                </Rule>
                <Rule Id="734">
                    <Text>456</Text>
                </Rule>
            </Mycategory>
        </Category>
    </Entry>
    <Entry Id="821">
        <Category>
            <Mycategory Style="One">
                <Rule Id="538">
                    <Text>xxxaaa</Text>
                </Rule>
                <Rule Id="366">
                    <Text>aaa</Text>
                </Rule>
            </Mycategory>
            <Mycategory Style="Two">
                <Rule Id="894">
                    <Text>xxxbbb</Text>
                </Rule>
                <Rule Id="921">
                    <Text>bbb</Text>
                </Rule>
            </Mycategory>
        </Category>
    </Entry>
</MyList>