Function КурсНБРБ(Optional ТипВалюты As String, Optional Дата As String) As Double     'аргументы: 'ТипВалюты' в виде "USD" и др. (в любом регистре), 'Дата' в виде "01.01.2015" (в любом формате); _
                                                                                       'если аргументы на задавать, то функция возвращается курс доллара на текущую дату
    Dim sRequest As String, sReqRes As String, sRes As String
    Dim sDay As String, sMonth As String, sYear As String
    Dim lPos As Long, oHttp
    Dim sCurCode As String, iQuant As Integer, dRes As Double
    Dim del As Integer
    
    If IsMissing(ТипВалюты) Or ТипВалюты = "" Then ТипВалюты = "USD"
    If IsMissing(Дата) Or Дата = "" Then Дата = Now
    If Not IsDate(Дата) Then Дата = CDate(Дата)
    
    If Дата >= #7/1/2016# Then
        Select Case UCase(ТипВалюты)                                                       'внутренние коды валют Нацбанка для запроса
            Case "USD": sCurCode = "145"
            Case "EUR": sCurCode = "292"
            Case "RUB": sCurCode = "298": del = 100
            Case "GBP": sCurCode = "143"
            Case "JPY": sCurCode = "295": del = 100
            Case "CHF": sCurCode = "130"
            Case "AUD": sCurCode = "170"
            Case "CAD": sCurCode = "23"
            Case "UAH": sCurCode = "290": del = 100
            Case "PLN": sCurCode = "293": del = 10
            Case "CNY": sCurCode = "304": del = 10
            Case "KZT": sCurCode = "301": del = 1000
            Case "NZD": sCurCode = "286"
        End Select
    Else
        Select Case UCase(ТипВалюты)
            Case "USD": sCurCode = "145"
            Case "EUR": sCurCode = "19"
            Case "RUB": sCurCode = "190"
            Case "GBP": sCurCode = "143"
            Case "JPY": sCurCode = "277": del = 10
            Case "CHF": sCurCode = "130"
            Case "AUD": sCurCode = "170"
            Case "CAD": sCurCode = "23"
            Case "UAH": sCurCode = "224"
            Case "PLN": sCurCode = "219"
            Case "CNY": sCurCode = "254"
            Case "KZT": sCurCode = "222"
            Case "NZD": sCurCode = "286"
        End Select
    End If
    
    sDay = Format(Дата, "dd"): sMonth = Format(Дата, "mm"): sYear = Format(Дата, "yyyy")
    sRequest = "http://www.nbrb.by/Services/XmlExRatesDyn.aspx?curid=" & sCurCode & "&fromDate=" & sMonth & "/" & sDay & "/" & sYear & "&toDate=" & sMonth & "/" & sDay & "/" & sYear
    
    On Error Resume Next
    Set oHttp = CreateObject("MSXML2.XMLHTTP")
    If Err <> 0 Then
        Set oHttp = CreateObject("MSXML.XMLHTTPRequest")
    End If
    If oHttp Is Nothing Then Exit Function
    oHttp.Open "GET", sRequest, False
    oHttp.Send
    sReqRes = oHttp.responseText                                                        'присвоение исходного кода запроса переменной sReqRes
    
    lPos = InStr(1, sReqRes, "<Rate>", 1) + 6                                           'поиск символов курса в исходном коде запроса
    sRes = Mid(sReqRes, lPos)                                                           'исключение лишних символов слева
    iQuant = Len(sRes) - 34                                                             'исключение лишних символов справа
    sRes = Left(sRes, iQuant)                                                           'присовение переменной sRes значения курса
    
    КурсНБРБ = sRes
        
    If del > 0 Then
        dRes = CDbl(sRes)
        КурсНБРБ = CStr(dRes / del)
            If dRes = 0 Then
            sRes = Replace(sRes, ".", ",")                                              'в исходном коде запроса разделитель целой и дробной части - точка; эта часть кода
            dRes = CDbl(sRes) / del                                                     'преобразует точку в запятую для тех пользователей, у кого разделитель - запятая
            КурсНБРБ = CStr(dRes)
            End If
    End If
    
    If Not IsMissing(ТипВалюты) And КурсНБРБ = 0 Then
        КурсНБРБ = Replace(sRes, ".", ",")
    End If
    
    Set oHttp = Nothing

End Function