Импорт курса валюты с сайта ЦБ РФ

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

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

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

Public Function GetCurrencyRate(sCurrencyName As String, Optional vDate As Variant = Null) As Currency
' Курс берётся по адресу http://www.cbr.ru/currency_base/D_print.aspx?date_req=dd.mm.yyyy
'--------------------------------------------------------------------------
'Аргументы:
'   sCurrencyName  = Трёх буквенное обозначение валюты "USD", "EUR" и т.п.
'   vDate          = Опционально Дата на которую - по умолчанию = Текущая Дата
'--------------------------------------------------------------------------
Dim sURI As String, oHttp As Object, HTMLcode, OutStr As String
Dim sDate As String, m As String, y As String, divider As Currency
Dim foundRate As String, foundCount As String
Dim pLeft As Long, pRight As Long
'--------------------------------------------------------------------------
 
On Error GoTo GetCurrencyRate_Err
    If IsNull(vDate) Then vDate = Date 'если дата не указана = Сегодня!
    sDate = Format(vDate, "dd\/mm\/yyyy\")
    sURI = "http://www.cbr.ru/scripts/XML_daily.asp?date_req=" & sDate
    'Debug.Print sURI
 
    Set oHttp = CreateObject("MSXML2.XMLHTTP")

    oHttp.Open "GET", sURI, False
    oHttp.Send
    HTMLcode = oHttp.ResponseText
    'Debug.Print HTMLcode
    
' определяем начало строки с искомым кодом валюты
    pLeft = InStr(InStr(1, HTMLcode, sCurrencyName) + 3, HTMLcode, "<Nominal>") + Len("<Nominal>")
' выделяем число едениц за которое указана цена
    pRight = InStr(pLeft, HTMLcode, "Nominal>")
    foundCount = Mid(HTMLcode, pLeft, pRight - pLeft)
' между этими скобками находится цифра в виде строки, которая является количеством единиц валюты, преобразовываем в число
    divider = val(foundCount)
' ищем курс валюты
    pLeft = InStr(pRight, HTMLcode, "Value") + Len("/Value")
    pRight = InStr(pLeft, HTMLcode, "/Value") - 1
    foundRate = Mid(HTMLcode, pLeft, pRight - pLeft)
' берём символы курса валюты между этих границ, преобразовываем в тип Double и делим на количество единиц валюты
    GetCurrencyRate = CCur(foundRate) / divider
'На некоторые валюты курс выставляется не кратный 1, поэтому делим на кратность курса

GetCurrencyRate_End:
    On Error Resume Next
    Set oHttp = Nothing
    Exit Function
    
GetCurrencyRate_Err:
    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure GetCurrencyRate", vbCritical
    Err.Clear
    Resume GetCurrencyRate_End
End Function