Parsing xml string in 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

What is nothing xNode or .SelectSingleNode? not sure if you need to get into the currency 1st? — Nathan_Sav
– Nathan_Sav, Commented Jan 26, 2016 at 18:01
OK i found the problem i guess...it seem like XDoc.LoadXML class cant get an xml with "header":<?xml version="1.0" encoding="utf-8" standalone="yes"?> if i am "cleaning" that "header" it is working with xNode.ChildNodes(1).SelectSingleNode("RATE").Text property. — Jonathan Applebaum
– Jonathan Applebaum, Commented Jan 26, 2016 at 18:05
there must be a way to do it with the header of the xml without i will need to remove this substring but how?? — Jonathan Applebaum
– Jonathan Applebaum, Commented Jan 26, 2016 at 18:10

Tomalak · Accepted Answer · 2016-01-26 19:25:12Z

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

edited Jan 26, 2016 at 19:25

answered Jan 26, 2016 at 18:23

Tomalak

339k68 gold badges547 silver badges635 bronze badges

Sign up to request clarification or add additional context in comments.

4 Comments

Tomalak Over a year ago

@jonathana See expanded answer. You might find some of it useful. Note the use if the XMLHTTP object + responseXML, instead of using a separate document + LoadXml.

Jonathan Applebaum Over a year ago

wow thank you so much! definitely going to use that. also it answer what i was wondering to my self while using the XMLHTTP objects - why i need to use separate document + LoadXml.

QHarr Over a year ago

Does .readyState <> 4 achieve anything with a Get request as above please?

Tomalak Over a year ago

Yes. See the documentation of readyState.

Nathan_Sav · Accepted Answer · 2016-01-26 18:29:39Z

0

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

answered Jan 26, 2016 at 18:29

Nathan_Sav

8,5762 gold badges18 silver badges22 bronze badges

Collectives™ on Stack Overflow

Parsing xml string in VBA

2 Answers 2

4 Comments

Comments

Your Answer

Hot Network Questions

Collectives™ on Stack Overflow

2 Answers 2

4 Comments

Comments

Your Answer

Sign up or log in

Post as a guest

Related