Загрузка курса валют через интернет

[Andrey Fedorov]

Никто не поделится примером реализации загрузки курса валют через интернет (ну скажем с сайта центробанка или откуда еще). Кстати, откуда лучше?

[Scuder]

Вот, выдрал из своей древней программы, поэтому прошу не смеяться над способом обрабоки..
Я не стал ничего переделывать, но реально код можно уменьшить раза в 2..
Первая ссылка работает и по сей день, а с рамблером (то, что в комментах по коду) - надо тестить..

Код: Выделить всё

WebBrowser1.Navigate "http://stock.rbc.ru/demo/cb.0/intraday/"
'WebBrowser1.Navigate "http://finance.rambler.ru/"

Код: Выделить всё

Private Sub WebBrowser1_DocumentComplete(ByVal pDisp As Object, URL As Variant)

Dim i As Integer
Dim HTMLText As String
Dim TempKurs As String

HTMLText = WebBrowser1.Document.documentelement.innerhtml
If Len(HTMLText) = 0 Then GoTo KursErr1
   
For i = 1 To Len(HTMLText)
If Mid$(HTMLText, i, 10) = "Доллар США" Then GoTo KursNe1
'If Mid$(HTMLText, i, 10) = "Руб / $ ЦБ" Then GoTo KursNe1
Next i

GoTo KersErr1
   
KursNe1:
   
HTMLText = Mid$(HTMLText, i + 34, 7)
'HTMLText = Mid$(HTMLText, i + 61, 7)

For i = 1 To Len(HTMLText)
If Mid$(HTMLText, i, 1) = "." Then
     HTMLText = Mid$(HTMLText, 1, i - 1) + "," + Mid$(HTMLText, i + 1, Len(HTMLText))
End If

If Mid$(HTMLText, i, 1) = "<" Then
     HTMLText = Mid$(HTMLText, 1, i - 1)
     Exit For
End If
Next i
       
If Len(HTMLText) = 0 Then GoTo KursErr1
   
TempKurs = HTMLText

KursErr1:

End Sub

[Andrey Fedorov]

Можно еще так:

Код: Выделить всё

Option Explicit

Public Sub Main()
    Dim X As MSXML.DOMDocument, d As Date
    Dim curУЕ As Currency, curЕвро As Currency
   
    d = Date
   
    If ПолучитьКурсВалютыЦентробанка(d, True, X) Then
        If IsNumeric(X.Text) Then curЕвро = CCur(Mid$(X.Text, 3))
    End If
   
    If ПолучитьКурсВалютыЦентробанка(d, False, X) Then
        If IsNumeric(X.Text) Then curУЕ = CCur(Mid$(X.Text, 3))
    End If
   
    Debug.Print curУЕ, curЕвро
End Sub

Private Function ПолучитьКурсВалютыЦентробанка(dDate As Date, bЕвро As Boolean, X As MSXML.DOMDocument) As Boolean
    Dim sUrlRequest, iПопытка As Integer

    ' Создаем экземпляр объекта - XML парзера
    Set X = CreateObject("MSXML.DOMDocument")
   
    X.Async = False
    'запрос к серверу центробанка в принятом формате на получение xml документа
    sUrlRequest = "http://www.cbr.ru/scripts/XML_dynamic.asp?date_req1=" _
                & Format(dDate, "dd.mm.yyyy") _
                & "&date_req2=" & Format(dDate, "dd.mm.yyyy") _
                & "&VAL_NM_RQ=" & "R0123" & IIf(bЕвро, 9, 5)

    ' загружаем документ по url
    iПопытка = 1
    Do Until iПопытка > 10
        If X.Load(sUrlRequest) Then Exit Do
        DoEvents
        iПопытка = iПопытка + 1
    Loop
    If iПопытка > 10 Then
        Set X = Nothing
        Exit Function
    End If
    ПолучитьКурсВалютыЦентробанка = True
End Function