Scrape historic Exchange Rate from Web XML table by column in Excel

Question

I am trying to scrape historic exchange rates from a XML on FloatRates into cells in an excel table. It's currently returning #VALUE!.
I don't know how to reference the XML structure correctly. A difficulty faced is I want to retrieve the exchange rate in < td align="right" > (e.g. 0.83) by matching the currency name in < td > (e.g. Euro). See XML structure below. I've googled but to no avail but something like identifying column 3?

Any help appreciated - Thanks!

http://www.floatrates.com/historical-exchange-rates.html?currency_date=2021-02-04&base_currency_code=USD&format_type=xml

Formula in the cell (table)

=GetHistoricFX([@[PURCHASE FX]],[@[SALE FX]],[@ETA])

XML Structure

xml structure 1

VBA

Function GetHistoricFX(fromCurr As String, toCurr As String, AsofDate As Date) As String

Dim xmlHttp As Object
Dim sUrl As String
Dim xmldoc As Object
Dim TDelements As Object
Dim TDelement As Object


' Create an XMLHTTP object
Set xmlHttp = CreateObject("MSXML2.XMLHTTP")

' get the URL to open
sUrl = "http://www.floatrates.com/historical-exchange-rates.html?" _
& "currency_date=" & AsofDate _
& "&base_currency_code=" & fromCurr _
& "&format_type=xml"


' open connection and get data
xmlHttp.Open "GET", sUrl, False
xmlHttp.send

Set xmldoc = CreateObject("xmlfile")

With xmldoc
    If xmlHttp.readyState = 4 And xmlHttp.Status = 200 Then 'readystate checks loading, status checks the validity of URL
'assign the returned text to a HTML document
.body.innerText = xmlHttp.responseText
  
Set TDelements = .getElementsByClassName("row")
'Loop within Table elements
For Each TDelement In TDelements
    If RateFound = True Then
        GetHistoricFX = TDelement.innerText
        Exit For
    End If
    If TDelement.innerText = toCurr Then RateFound = True
Next
End If
End With

Set xmlHttp = Nothing

End Function

That is HTML not XML, and I've never seen CreateObject("xmlfile") - do you have a reference for that? — Tim Williams
With format_type=xml you load a XML. So you can't work with .getElementsByClassName("row"). But you can switch to HTML with format_type=html. I have checked that with Debug.Print xmlHttp.responseText. But there are other errors in your code. RateFound is not needed. But if you want it it's on the wrong position and it is not declared. Also you don't want the innertext of TDelement because that's toCurr. I have no time now to look further into the code. — Zwenn

Parfait Parfait · Accepted Answer · 2021-02-05T21:12:21

As commented, the specific URL posted is an XML that uses an XSLT stylesheet to render page as HTML. But underlying source and therefore the response text is XML. See XML data source with Ctrl+U:

XML

<?xml version="1.0" encoding="utf-8"?>
<?xml-stylesheet type="text/xsl" href="http://www.floatrates.com/currency-rates.xsl" ?>
<channel>
    <title>XML Historical Foreign Exchange Rates for U.S. Dollar (USD) (4 Feb 2021)</title>
    <link>http://www.floatrates.com/currency/usd/</link>
    <xmlLink>http://www.floatrates.com/daily/usd.xml</xmlLink>
    <description>XML historical foreign exchange rates for U.S. Dollar (USD) from the Float Rates. Published at 4 Feb 2021.</description>
    <language>en</language>
    <baseCurrency>USD</baseCurrency>
    <pubDate>Thu, 4 Feb 2021</pubDate>
    <lastBuildDate>Thu, 4 Feb 2021</lastBuildDate>
    
    <item>
        <title>1 USD = 0.832481 EUR</title>
        <link>http://www.floatrates.com/usd/eur/</link>
        <description>1 U.S. Dollar = 0.832481 Euro</description>
        <pubDate></pubDate>
        <baseCurrency>USD</baseCurrency>
        <baseName>U.S. Dollar</baseName>
        <targetCurrency>EUR</targetCurrency>
        <targetName>Euro</targetName>
        <exchangeRate>0.832481</exchangeRate>
        <inverseRate>1.201229</inverseRate>
        <inverseDescription>1 Euro = 1.201229 U.S. Dollar</inverseDescription>
    </item>
    <item>
        <title>1 USD = 0.733621 GBP</title>
        <link>http://www.floatrates.com/usd/gbp/</link>
        <description>1 U.S. Dollar = 0.733621 U.K. Pound Sterling</description>
        <pubDate></pubDate>
        <baseCurrency>USD</baseCurrency>
        <baseName>U.S. Dollar</baseName>
        <targetCurrency>GBP</targetCurrency>
        <targetName>U.K. Pound Sterling</targetName>
        <exchangeRate>0.733621</exchangeRate>
        <inverseRate>1.363101</inverseRate>
        <inverseDescription>1 U.K. Pound Sterling = 1.363101 U.S. Dollar</inverseDescription>
    </item>
    ...
</channel>

But you can still parse the response return and run XPath on <item> node data. Simply use MSXML's DomDocument with LoadXML and SelectNodes methods.

VBA

Sub CallFunc()
    Call GetHistoricFX("USD", "", "2021-02-04")
End Sub

Function GetHistoricFX(fromCurr As String, toCurr As String, AsofDate As Date) As String
On Error GoTo ErrHandle
    Dim xmlHttp As Object
    Dim sUrl As String
    Dim xmldoc As Object, itemNodes As Object, itemNode As Variant, chNode As Variant
    Dim i As Long, j As Long
          
    ' Create an XMLHTTP object
    Set xmlHttp = CreateObject("MSXML2.XMLHTTP")
    
    ' get the URL to open
    sUrl = "http://www.floatrates.com/historical-exchange-rates.html?" _
            & "currency_date=" & AsofDate _
            & "&base_currency_code=" & fromCurr _
            & "&format_type=xml"
        
    ' open connection and get data
    xmlHttp.Open "GET", sUrl, False
    xmlHttp.send
    
    ' CREATE A DOMDocument OBJECT FROM RESPONSE
    Set xmldoc = CreateObject("MSXML2.DOMDocument")
    xmldoc.LoadXML xmlHttp.responseText
    xmldoc.setProperty "SelectionLanguage", "XPath"

    Set itemNodes = xmldoc.SelectNodes("//item")

    ' ITERATE THROUGH ITEM NODES AND CHILDREN
    With ThisWorkbook.Worksheets("MAIN")
        i = 2
        For Each itemNode In itemNodes
            j = 1
            For Each chNode In itemNode.SelectNodes("*")
                If i = 2 Then
                    .Cells(i - 1, j) = chNode.tagName
                End If
                .Cells(i, j).Value = chNode.Text
                j = j + 1
            Next chNode
            i = i + 1
        Next itemNode
    End With
    
    MsgBox "Successfully completed!", vbInformation
    
ExitHandle:
    Set chNode = Nothing
    Set itemNode = Nothing
    Set itemNodes = Nothing
    Set xmldoc = Nothing
    Set xmlHttp = Nothing
    Exit Function
    
ErrHandle:
    MsgBox Err.Number & " - " & Err.Description, vbCritical
    Resume ExitHandle
End Function

Output

Scrape historic Exchange Rate from Web XML table by column in Excel

2 Answers