Wednesday 26 August 2020

VBA - Use Dom.SelectNodes and double slash XPath to jump in anywhere in an Xml Document

Don't be tempted to loop through an Xml structure algorithmically when you can jump in using some double slash prefixed XPath.

A question arose on StackOverflow which sadly had been closed by the moderators, so I solved it myself and published the answer here. The questioner says

I want to have flexible code so that I can just point to the nodepath of the financial value and then simply go up or down in the XML tree to find all the other data I need.

So the questioner would prefer not to write code for every Xml document structure instead find the a key node and expect to find the supplementary data in elements not far away. They have given some test data and I have given some code to handle both.

A key feature of the code is to use the SelectNodes() method of the DomDocument object which will give a list of multiple matches. To avoid specifying fixed paths use double slash!

Enjoy!

Option Explicit

Private Sub TestListSingleFinancialValueItems()
    ListSingleFinancialValueItems TestData1
End Sub

Private Sub TestListMultipleFinancialValues()
    ListMultipleFinancialValues TestData2
End Sub

Private Sub ListMultipleFinancialValues(ByVal dom As MSXML2.DOMDocument60)

    Dim nodesFinancialValues As MSXML2.IXMLDOMNodeList
    Set nodesFinancialValues = dom.SelectNodes("//financialvalues")
    
    Dim nodeFinVal As MSXML2.IXMLDOMElement
    For Each nodeFinVal In nodesFinancialValues
        
        Dim sCurrency As String: sCurrency = ""
        
        Dim nodsChildVals As MSXML2.IXMLDOMNodeList
        Set nodsChildVals = nodeFinVal.SelectNodes("value")
        
        If nodsChildVals.Length > 0 Then
            sCurrency = ReadCurrency(nodeFinVal.PreviousSibling)
            Debug.Assert sCurrency <> ""
            
            Dim vals As MSXML2.IXMLDOMElement
            For Each vals In nodsChildVals
                Debug.Print sCurrency & " " & vals.Text
            Next
        End If
    Next

End Sub


Private Sub ListSingleFinancialValueItems(ByVal dom As MSXML2.DOMDocument60)

    Dim nodesFinancialValues As MSXML2.IXMLDOMNodeList
    Set nodesFinancialValues = dom.SelectNodes("//financialvalue")
    
    Dim nodeFinVal As MSXML2.IXMLDOMElement
    For Each nodeFinVal In nodesFinancialValues
        
        Dim sCurrency As String: sCurrency = ""
        sCurrency = ReadCurrency(nodeFinVal.NextSibling)
        Debug.Assert sCurrency <> ""
        Debug.Print sCurrency & " " & nodeFinVal.Text
    Next
End Sub

Private Function ReadCurrency(ByVal xmlElement As MSXML2.IXMLDOMElement) As String
    If Not xmlElement Is Nothing Then
        If xmlElement.BaseName = "currency" Then
            ReadCurrency = xmlElement.Text
        End If
    End If
End Function

Function TestData1() As MSXML2.DOMDocument60
    Dim s
    s = _
    "<transactions>" & _
    "    <transaction>" & _
    "        <transactionID>5</transactionID>" & _
    "        <lines>" & _
    "            <line>" & _
    "                <financialvalue>100.00</financialvalue>" & _
    "                <currency>USD</currency>" & _
    "            </line>" & _
    "            <line>" & _
    "                <financialvalue>200.00</financialvalue>" & _
    "                <currency>USD</currency>" & _
    "            </line>" & _
    "         </lines>" & _
    "    </transaction>" & _
    "</transactions>"
    Dim dom As MSXML2.DOMDocument60
    Set dom = New MSXML2.DOMDocument60
    Debug.Assert dom.LoadXML(s)
    Set TestData1 = dom
End Function

Function TestData2() As MSXML2.DOMDocument60
    Dim s
    s = _
    "<transactions>" & _
    "    <transaction>" & _
    "        <currency>USD</currency>" & _
    "        <financialvalues>" & _
    "            <value>100.00</value>" & _
    "            <value>200.00</value>" & _
    "        </financialvalues>" & _
    "    </transaction>" & _
    "    <transaction>" & _
    "        <currency>USD</currency>" & _
    "        <financialvalues>" & _
    "            <value>300.00</value>" & _
    "            <value>400.00</value>" & _
    "        </financialvalues>" & _
    "    </transaction>" & _
    "</transactions>"
    Dim dom As MSXML2.DOMDocument60
    Set dom = New MSXML2.DOMDocument60
    Debug.Assert dom.LoadXML(s)
    Set TestData2 = dom
End Function