Импорт курса валюты с сайта ЦБ Украины

По материалам: http://www.cyberforum.ru/ms-access/thread2354116.html

Примеры эксплуатации:

?GetCurrencyRateUA("EUR")
?GetCurrencyRateUA("USD")
?GetCurrencyRateUA("EUR", #01/01/2018#)

ЦЕНТР БАНК УКРАИНЫ И ПОД КУРС ГРИВНЫ:

Public Function GetCurrencyRateUA(sCurrencyName As String, Optional vDate As Variant = Null) As Double
'es 19.11.2019
'Курс берётся по адресу https://bank.gov.ua/NBUStatService/v1/statdirectory/exchange?valcode=...&date=...
'--------------------------------------------------------------------------
'Аргументы:
'   sCurrencyName  = Трёх буквенное обозначение валюты "USD", "EUR" и т.п.
'   vDate          = Опционально Дата на которую - по умолчанию = Текущаяя
'--------------------------------------------------------------------------
Dim sURI As String, oHttp As Object, HTMLcode
Dim sDate$, pLeft As Integer, pRight As Integer, v As Variant
'--------------------------------------------------------------------------
 
On Error GoTo GetCurrencyRateUA_Err
    If IsNull(vDate) Then vDate = Date 'если дата не указана = Сегодня!
 
    sDate = Format(vDate, "yyyymmdd")
    sURI = "https://bank.gov.ua/NBUStatService/v1/statdirectory/exchange?valcode=" & sCurrencyName & "&date=" & sDate
    'Debug.Print sURI
 
    Set oHttp = CreateObject("MSXML2.XMLHTTP")
 
    oHttp.Open "GET", sURI, False
    oHttp.Send
    HTMLcode = oHttp.ResponseText
    'Debug.Print HTMLcode
 
    pLeft = InStr(1, HTMLcode, "<rate>") + 6
    pRight = InStr(1, HTMLcode, "</rate>")
    v = val(Mid(HTMLcode, pLeft, pRight - pLeft)) ' rate
    'Debug.Print v
    If IsNumeric(v) Then
        GetCurrencyRateUA = CDbl(v)
    End If
 
GetCurrencyRateUA_End:
    On Error Resume Next
    Set oHttp = Nothing
    Exit Function
    
GetCurrencyRateUA_Err:
    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure GetCurrencyRateUA", vbCritical
    Err.Clear
    Resume GetCurrencyRateUA_End
End Function