Макрос (функция) для получения курса валют с сайта ЦБ РФ

Данный код (пользовательская функция) позволяет получить данные о курсе валюты с сайта Центробанка.

Данную функцию можно использовать и в виде формулы на листе Excel (см. пример во вложении)

Function GetRate(ByVal CurrencyName As String, ByVal RateDate As Date) As Double
    ' функция возвращает курс валюты CurrencyName на дату RateDate
    ' в случае ошибки (неверная дата или название валюты) возвращается 0
    On Error Resume Next
    CurrencyName = UCase(CurrencyName): If Len(CurrencyName) <> 3 Then Exit Function
    Set xmldoc = CreateObject("Msxml.DOMDocument"): xmldoc.async = False
    url_request = "http://www.cbr.ru/scripts/XML_daily.asp?date_req=" + Format(RateDate, "dd\/mm\/yyyy")
 
    If xmldoc.Load(url_request) <> True Then Exit Function    ' Запрос к серверу ЦБР

    ' Обработка полученного ответа
    Set nodeList = xmldoc.selectNodes("ValCurs"): Set xmlNode = nodeList.Item(0).CloneNode(True)
    Set node_attr = xmlNode.Attributes(0): strDate = node_attr.Value
    Set nodeList = xmldoc.selectNodes("*/Valute")
    For i = 0 To nodeList.Length - 1    ' поиск нужной валюты
        Set xmlNode = nodeList.Item(i).CloneNode(True)
        If xmlNode.childNodes(1).Text = CurrencyName Then
            CurrencyRate = CDbl(xmlNode.childNodes(4).Text)
            divisor = Val(xmlNode.childNodes(2).Text)
            GetRate = CurrencyRate / divisor
            Exit Function
        End If
    Next
End Function

Sub ПримерИспользованияФункции_GetRate()
    MsgBox "Сегодня курс доллара к рублю составил " & GetRate("USD", Now), vbInformation
    MsgBox "А вчера курс евро к рублю был равен " & GetRate("EUR", Now - 1), vbInformation
End Sub

Поддерживается получение курсов рубля по отношению к следующим валютам:

AUD               Австралийский доллар
AZN               Азербайджанский манат
GBP               Фунт стерлингов Соединенного королевства
AMD               Армянский драм
BYR               Белорусский рубль
BGN               Болгарский лев
BRL               Бразильский реал
HUF               Венгерский форинт
DKK               Датская крона
USD               Доллар США
EUR               Евро
INR               Индийская рупия
KZT               Казахский тенге
CAD               Канадский доллар
KGS               Киргизский сом
CNY               Китайский юань
LVL               Латвийский лат
LTL               Литовский лит
MDL               Молдавский лей
NOK               Норвежская крона
PLN               Польский злотый
RON               Новый румынский лей
XDR               СДР (специальные права заимствования)
SGD               Сингапурский доллар
TJS               Таджикский сомони
TRY               Турецкая лира
TMT               Новый туркменский манат
UZS               Узбекский сум
UAH               Украинская гривна
CZK               Чешская крона
SEK               Шведская крона
CHF               Швейцарский франк
EEK               Эстонская крона
ZAR               Южноафриканский рэнд
KRW               Вон Республики Корея
JPY               Японская иена

Если вы желаете вывести информацию по всем валютам - используйте макрос ВывестиСегодняшниеКурсыВсехВалют:

Sub ВывестиСегодняшниеКурсыВсехВалют()
    On Error Resume Next
    Set xmldoc = CreateObject("Msxml.DOMDocument"): xmldoc.async = False
    url_request = "http://www.cbr.ru/scripts/XML_daily.asp?date_req=" + Format(Now, "dd\/mm\/yyyy")
    If xmldoc.Load(url_request) <> True Then Exit Sub
    Set nodeList = xmldoc.selectNodes("ValCurs"): Set xmlNode = nodeList.Item(0).CloneNode(True)
    Set node_attr = xmlNode.Attributes(0): strDate = node_attr.Value
    Set nodeList = xmldoc.selectNodes("*/Valute")
    For i = 0 To nodeList.Length - 1
        Set xmlNode = nodeList.Item(i).CloneNode(True)
        Debug.Print "Курс " & xmlNode.childNodes(1).Text & " (установлен " & strDate & "): " & _
                    xmlNode.childNodes(4).Text & " рублей за " & xmlNode.childNodes(2).Text & _
                  " " & xmlNode.childNodes(3).Text
    Next
End Sub

Результат работы макроса ВывестиСегодняшниеКурсыВсехВалют:

Курс AUD (установлен 28/07/2010): 27,2968 рублей за 1 Австралийский доллар
Курс AZN (установлен 28/07/2010): 37,6342 рублей за 1 Азербайджанский манат
Курс BRL (установлен 28/07/2010): 17,1589 рублей за 1 Бразильский реал
...
Курс HUF (установлен 28/07/2010): 13,7407 рублей за 100 Венгерских форинтов
Курс DKK (установлен 28/07/2010): 52,7135 рублей за 10 Датских крон
Курс USD (установлен 28/07/2010): 30,2391 рублей за 1 Доллар США
Курс EUR (установлен 28/07/2010): 39,3139 рублей за 1 Евро
...
Курс CHF (установлен 28/07/2010): 28,6953 рублей за 1 Швейцарский франк
Курс EEK (установлен 28/07/2010): 25,1057 рублей за 10 Эстонских крон
Курс ZAR (установлен 28/07/2010): 41,1383 рублей за 10 Южноафриканских рэндов
Курс KRW (установлен 28/07/2010): 25,6003 рублей за 1000 Вон Республики Корея