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

1. I am trying to scrape historic exchange rates from a XML on FloatRates into cells in an excel table. It's currently returning #VALUE!.

2. 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

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

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