пятница, 3 июля 2015 г.

Пример работы с web-запросами в макросах Excel

'Получить курс Евро на дату
Sub GetEuro()
   Range("B12").Select
   Dim sURI As String
    Dim oHttp As Object
    Dim htmlcode, outstr As String
    Dim inpdate As Date
    Dim d, m, y As Integer


    inpdate = CDate(InputBox("Введите дату в формате  DD.MM.YYYY", _
        "Курс Евро", Date))
    d = Format(inpdate, "dd")
    m = Format(inpdate, "mm")
    y = Format(inpdate, "yyyy")
    sURI = "http://WWW.cbr.ru/currency_base/daily.aspX?C_month=" & m & "&C_year=" & y & "&date_req=" & d & "%2F" & m & "%2F" & y
    On Error Resume Next
    Set oHttp = CreateObject("MSXML2.XMLHTTP")
    If Err.Number <> 0 Then
        Set oHttp = CreateObject("MSXML.XMLHTTPRequest")
    End If
    On Error GoTo 0
    If oHttp Is Nothing Then
        Exit Sub
    End If
    oHttp.Open "GET", sURI, False
    oHttp.Send
    htmlcode = oHttp.responseText
    outstr = Mid(htmlcode, InStr(1, htmlcode, "EUR") + 81, 7)
    Set oHttp = Nothing
    outstr = Replace(outstr, ",", ".")
    ActiveCell.Value = outstr
End Sub

Комментариев нет:

Отправить комментарий