Импорт курса валюты с сайта Национального банка Республики Беларусь

По материалам: https://www.cyberforum.ru/ms-access/thread1659325-page4.html#post16467375

Public Function Kurs_NBRB(onDate As Date, onTiker&) As Currency
'Национальный банк Республики Беларусь
'Официальный курс белорусского рубля по отношению к иностранным валютам
'https://www.nbrb.by/statistics/rates/currbasket
'---------------------------------------------------------------------------------------------------
'Аргументы:
'   onDate  = Дата курса
'   onTiker = Переключатель валюты: 2 = Доллар США ; 3 = Евро ; 4 = 100 Российских Рублей
'---------------------------------------------------------------------------------------------------
Const csURLStart$ = "https://www.nbrb.by/services/xmlexrates.aspx?ondate="
Dim XMLHTTP As Object
Dim sURL$, sPageBody$, sRate$, sVal$
Dim lRateStart&, lRateEnd&
On Error GoTo Kurs_NBRB_Err

    sVal = Format(onDate, "mm\/dd\/yyyy")
    sURL = csURLStart & sVal
    
    Set XMLHTTP = CreateObject("MSXML2.XMLHTTP")
    XMLHTTP.Open "GET", sURL, False
    sVal = "Mozilla/5.0 (Windows NT 10.0; Win64; x64) " & _
        "AppleWebKit/537.36 (KHTML, like Gecko) Chrome/105.0.0.0 Safari/537.36"
    XMLHTTP.setRequestHeader "User-Agent", sVal
    XMLHTTP.Send
    
    If Not XMLHTTP.Status = 200 Then
        MsgBox "Отсутствует соединение...", vbExclamation, "Ошибка доступа"
        GoTo Kurs_NBRB_End
    End If
    
    Select Case onTiker
        Case 2: sVal = "Доллар США</Name>"
        Case 3: sVal = "Евро</Name>"
        Case 4: sVal = "Российских рублей</Name>"
        Case Else:  GoTo Kurs_NBRB_End
    End Select
    
    sPageBody = XMLHTTP.responseText
    lRateStart = InStr(1, sPageBody, sVal) + Len(sVal) + 12
    lRateEnd = InStr(lRateStart, sPageBody, "</Rate>")
    sRate = Replace(Mid(sPageBody, lRateStart, lRateEnd - lRateStart), ".", ",")
    
    If Not onTiker = 4 Then
        Kurs_NBRB = CCur(sRate)
    Else 'Курс за 100 Российских Рублей = Делим ...
        Kurs_NBRB = CCur(sRate) / 100
    End If

Kurs_NBRB_End:
    On Error Resume Next
    Set XMLHTTP = Nothing
    Err.Clear
    Exit Function

Kurs_NBRB_Err:
    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in Function : " & _
           "Kurs_NBRB - mod00Test.", vbCritical, "Error!"
    'Debug.Print "Kurs_NBRB_Line: " & Erl & "."
    Err.Clear
    Resume Kurs_NBRB_End
End Function