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, Feb 05 '21 at 17:30
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, Feb 05 '21 at 17:36

score 2 · Answer 1 · answered Feb 05 '21 at 21:12

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

Hi Parfait, thanks for such a detailed response! I get an error at Set xmldoc = CreateObject("MSXML2.DOMDocument") — Berry, Feb 08 '21 at 10:38
What version of MS Office are you running? What OS (Windows/Mac)? In VBA IDE, under Tools/References on menu, are there any entries for `Microsoft XML, v#.#`? — Parfait, Feb 08 '21 at 16:25
Please note and see I write data to the worksheet `MAIN`. Adjust to an existing sheet in your workbook. — Parfait, Feb 08 '21 at 16:26

Zwenn · Accepted Answer · 2021-02-05T18:11:29.703

Ok, I have invested the time now. It wasn't that much more.

I have tested it with =GetHistoricFX("USD";"EUR";"2021-02-04")

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

Dim xmlHttp As Object
Dim sUrl As String
Dim doc As Object
Dim TDelements As Object
Dim TDelement As Long
Dim result As String

  'Create an XMLHTTP object
  Set xmlHttp = CreateObject("MSXML2.XMLHTTP")
  Set doc = CreateObject("htmlFile")
  
  'get the URL to open
  sUrl = "http://www.floatrates.com/historical-exchange-rates.html?" _
  & "currency_date=" & AsofDate _
  & "&base_currency_code=" & fromCurr _
  & "&format_type=html"
  
  'open connection and get data
  xmlHttp.Open "GET", sUrl, False
  xmlHttp.send
  
  With doc
    If xmlHttp.Status = 200 Then
      'assign the returned text to a HTML document
      .body.innerHTML = xmlHttp.responseText
      Set TDelements = .getElementsByTagName("td")
      'Loop within Table elements
      For TDelement = 0 To TDelements.Length - 1
        If UCase(TDelements(TDelement).innerText) = UCase(toCurr) Then
          result = TDelements(TDelement + 1).innerText
          Exit For
        End If
      Next
    End If
  End With
  
  If Len(result) = 0 Then
    result = "#NL" 'like #NA is 'Not Available', #NL is 'Not Loaded'
  End If
  
  GetHistoricFX = result
End Function

Please provide fuller textual explanation for future readers. Notably you changed OP's response type in URL from XML to HTML: `&format_type=html`. — Parfait, Feb 05 '21 at 21:15
@Parfait I have explained the change of the parameter to `html` in my comment under the question of the OP. I hadn't much time for the solution. But it's not very special. — Zwenn, Feb 05 '21 at 21:46

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

2 Answers2