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

Fake namespace! VBA MSXML2 XPath namespace looks like we need to fake a prefix for the default namespace

This is more a TODO post to myself to find a better solution to a VBA Xml programming program. Visitors are welcome to comment at the bottom if they know a better answer.

So a while ago, I had a problem with using XPath to get some elements out of an Xml Dom using VBA Xml library, MSXML2. You can see my SO question about it here. I expressed unhappiness about how we have to fake a prefix when setting the dom's SelectionNamespace.

Today a similar question arose but the twist here is that multiple namespaces have to be set. Here is my answer.

To set multiple namespaces simply space separate thus...

    dom.setProperty "SelectionNamespaces", "xmlns:sf='urn:sobject.enterprise.soap.sforce.com' xmlns:sf2='urn:enterprise.soap.sforce.com'"

(I omitted a couple of namespaces for formatting issues but you get the idea)

So I got some code working for the OP but I'd really like to find a way to not have to fake the prefix. In the source Xml note xmlns="urn:enterprise.soap.sforce.com" has no prefix but in our VBA we have to fake it with "sf2".

As a working resource I'm copying the Xml file here and the code below

<?xml version="1.0" encoding="UTF-8" ?>
<soapenv:Envelope xmlns:soapenv="http://schemas.xmlsoap.org/soap/envelope/" xmlns="urn:enterprise.soap.sforce.com" xmlns:sf="urn:sobject.enterprise.soap.sforce.com" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" >
  <soapenv:Header>
    <LimitInfoHeader>
      <limitInfo>
        <current>50</current>
        <limit>5000000</limit>
        <type>API REQUESTS</type>
      </limitInfo>
    </LimitInfoHeader>
  </soapenv:Header>
  <soapenv:Body>
    <queryResponse>
      <result>
        <done>true</done>
        <queryLocator xsi:nil="true"/>
        <records xsi:type="sf:Nodav">
          <sf:Id>a0S0E000000DMUg320</sf:Id>
          <sf:Name>Netta test 11</sf:Name>
        </records>
        <records xsi:type="sf:Nodav">
          <sf:Id>a0S0E000000DMUg321</sf:Id>
          <sf:Name>Netta test 32</sf:Name>
        </records>
        <size>2</size>
      </result>
    </queryResponse>
  </soapenv:Body>
</soapenv:Envelope>

Option Explicit


Sub TestCoreLogic()
    Dim dom As MSXML2.DOMDocument60
    Set dom = New MSXML2.DOMDocument60
    
    dom.Load "N:\xmlfile1.xml"
    Debug.Assert dom.parseError.ErrorCode = 0

    dom.setProperty "SelectionLanguage", "XPath"
    
    dom.setProperty "SelectionNamespaces", "xmlns:sf='urn:sobject.enterprise.soap.sforce.com' xmlns:sf2='urn:enterprise.soap.sforce.com' " & _
            "xmlns:soapenv='http://schemas.xmlsoap.org/soap/envelope/' xmlns:xsi='http://www.w3.org/2001/XMLSchema-instance' "
    
    CoreLogic dom
End Sub
'
Function CoreLogic(ByVal xmlDoc As MSXML2.DOMDocument60)

    Dim records As MSXML2.IXMLDOMElement
    Set records = xmlDoc.DocumentElement
    
    Dim lists As MSXML2.IXMLDOMNodeList
    
    'Debug.Assert records.SelectNodes("//soapenv:Envelope").Length = 1
    'Debug.Assert records.SelectNodes("//soapenv:Envelope/soapenv:Body").Length = 1
    'Debug.Assert records.SelectNodes("//soapenv:Envelope/soapenv:Body/sf2:queryResponse").Length = 1
    'Debug.Assert records.SelectNodes("//soapenv:Envelope/soapenv:Body/sf2:queryResponse/sf2:result").Length = 1
    '
    'Debug.Assert records.SelectNodes("//soapenv:Envelope/soapenv:Body/sf2:queryResponse/sf2:result/sf2:records").Length = 2
    'Set lists = records.SelectNodes("//soapenv:Envelope/soapenv:Body/sf2:queryResponse/sf2:result/sf2:records")
    
    Debug.Assert records.SelectNodes("//sf2:records").Length = 2
    Set lists = records.SelectNodes("//sf2:records")

    Dim listNode As MSXML2.IXMLDOMNode
    
    For Each listNode In lists
        Debug.Print "---Email---"
        
        Dim fieldNode As MSXML2.IXMLDOMNode
        For Each fieldNode In listNode.ChildNodes
            Debug.Print "[" & fieldNode.BaseName & "] = [" & fieldNode.Text & "]"
        Next fieldNode
    Next listNode

    Set records = Nothing
    Set lists = Nothing
    Set listNode = Nothing
    Set fieldNode = Nothing


End Function