Parsing xml string in VBA - vba

Question

I am trying to parse xml document that i am getting from a website.
from some reason i cant figure out i cant parse the value inside the 'RATE' node.
the xml string seems O.K.
but in the end of the code (commented) i get Object variable or With block variable not set error.
i will be grateful for any help.
XML STRING:
<?xml version="1.0" encoding="utf-8" standalone="yes"?>
<CURRENCIES>
<LAST_UPDATE>2016-01-25</LAST_UPDATE>
<CURRENCY>
<NAME>Dollar</NAME>
<UNIT>1</UNIT>
<CURRENCYCODE>USD</CURRENCYCODE>
<COUNTRY>USA</COUNTRY>
<RATE>3.982</RATE>
<CHANGE>0.277</CHANGE>
</CURRENCY>
</CURRENCIES>
VBA CODE:
Private Sub loadXMLString(xmlString)
Dim strXML As String
Dim xNode As IXMLDOMNode
Dim XDoc As MSXML2.DOMDocument
strXML = xmlString
Set XDoc = New MSXML2.DOMDocument
If Not XDoc.LoadXML(strXML) Then 'strXML is the string with XML'
Err.Raise XDoc.parseError.ErrorCode, , XDoc.parseError.reason
End If
Set xNode = XDoc.FirstChild
Debug.Print xNode.SelectSingleNode("RATE").Text ' here i get the Object variable or With block variable not set error
Debug.Print xNode.ChildNodes(2).SelectSingleNode("RATE").Text ' also with that try i get the Object variable or With block variable not set error
End Sub
UPDATE:
i found the problem (as i wrote down in the comments to #Nathan).
the problem is the <?xml version="1.0" encoding="utf-8" standalone="yes"?> node
Tested it an this code is working:
so how can i do that with out to remove this node as a substring, there must be a way i guess, but i dont have a lot of experience working with XML
Private Sub loadXMLString(xmlString)
Dim strXML As String
Dim xNode As IXMLDOMNode
Dim XDoc As MSXML2.DOMDocument
strXML = "<CURRENCIES>" & _
"<LAST_UPDATE>2016-01-25</LAST_UPDATE>" & _
"<CURRENCY>" & _
"<NAME>Dollar</NAME>" & _
"<UNIT>1</UNIT>" & _
"<CURRENCYCODE>USD</CURRENCYCODE>" & _
"<COUNTRY>USA</COUNTRY>" & _
"<RATE>3.982</RATE>" & _
"<CHANGE>0.277</CHANGE>" & _
"</CURRENCY>" & _
"</CURRENCIES>"
Set XDoc = New MSXML2.DOMDocument
If Not XDoc.LoadXML(strXML) Then 'strXML is the string with XML'
Err.Raise XDoc.parseError.ErrorCode, , XDoc.parseError.reason
End If
Set xNode = XDoc.FirstChild
Debug.Print strXML
Debug.Print xNode.ChildNodes(1).SelectSingleNode("RATE").Text ' also with that try i get the Object variable or With block variable not set error
End Sub

Answer 1

SelectSingleNode() expects an XPath expression. Try this one:
xNode.SelectSingleNode("//RATE").Text
But in general it's not very smart to access properties of an object reference that could be Nothing – like it is in the above case, if SelectSingleNode does not find any matching node, this line will trigger a run-time error ("Object variable or With block variable not set", which effectively is a null pointer exception.)
Always guard your property accesses by validating your object reference:
Set rate = xNode.SelectSingleNode("//RATE")
If rate Is Nothing Then
Debug.Print "Error: no RATE found in document"
Else
Debug.Print rate.Text
End If
FWIW, here is a complete version of the code I would use, featuring a few nice details like a custom type for currency information and the use the Sleep() function to wait for the server to return the XML document:
Option Explicit
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Public Type CurrencyInfo
Success As Boolean
LastUpdate As Date
Name As String
Unit As Double
CurrencyCode As String
Country As String
Rate As Double
Change As Double
End Type
Private Function GetXmlDoc(url As String) As MSXML2.DOMDocument60
With New MSXML2.XMLHTTP60
.Open "GET", url, False
.send
While .readyState <> 4: Sleep 50: Wend
If .Status = 200 Then
If .responseXML.parseError.ErrorCode = 0 Then
Set GetXmlDoc = .responseXML
Else
Err.Raise vbObjectError + 1, "GetXmlDoc", "XML parser error: " & .responseXML.parseError.reason
End If
Else
Err.Raise vbObjectError + 2, "GetXmlDoc", "Server responded with status code " & .Status
End If
End With
End Function
Public Function GetCurrencyInfo(currencyName As String) As CurrencyInfo
Dim curr As MSXML2.DOMDocument60
Set curr = GetXmlDoc("http://the/url/you/use?currency=" + currencyName)
GetCurrencyInfo.Success = True
GetCurrencyInfo.LastUpdate = CDate(GetText(curr, "//LAST_UPDATE"))
GetCurrencyInfo.Name = GetText(curr, "//NAME")
GetCurrencyInfo.Unit = Val(GetText(curr, "//UNIT"))
GetCurrencyInfo.CurrencyCode = GetText(curr, "//CURRENCYCODE")
GetCurrencyInfo.Country = GetText(curr, "//COUNTRY")
GetCurrencyInfo.Rate = Val(GetText(curr, "//RATE"))
GetCurrencyInfo.Change = Val(GetText(curr, "//CHANGE"))
End Function
Private Function GetText(context As IXMLDOMNode, path As String) As String
Dim result As IXMLDOMNode
If Not context Is Nothing Then
Set result = context.SelectSingleNode(path)
If Not result Is Nothing Then GetText = result.Text
End If
End Function
Usage is as follows:
Sub Test()
Dim USD As CurrencyInfo
USD = GetCurrencyInfo("USD")
Debug.Print "LastUpdate: " & USD.LastUpdate
Debug.Print "Name: " & USD.Name
Debug.Print "Unit: " & USD.Unit
Debug.Print "CurrencyCode: " & USD.CurrencyCode
Debug.Print "Country: " & USD.Country
Debug.Print "Rate: " & USD.Rate
Debug.Print "Change: " & USD.Change
End Sub

Answer 2

Tried this, and got somwhere.
Dim strXML As String
Dim xNode As IXMLDOMNode
Dim XDoc As MSXML2.DOMDocument
Dim xParent As IXMLDOMNode
Dim xChild As MSXML2.IXMLDOMNode
strXML = xmlString
Set XDoc = New MSXML2.DOMDocument
If Not XDoc.Load(strXML) Then 'strXML is the string with XML'
Err.Raise XDoc.parseError.ErrorCode, , XDoc.parseError.reason
End If
Set xNode = XDoc.DocumentElement
Set xParent = xNode.FirstChild
For Each xParent In xNode.ChildNodes
For Each xChild In xParent.ChildNodes
Debug.Print xChild.Text
Next xChild
Next xParent