Using HTTPXML to get data from the Web

This sample code shows how to use XMLHTTP library to send a request and then get a response  from web server. This code actually getting currency exchange rate from Central bank of Russia

Public Function GetRateCBR(dDate As Date, strCurCode As String) As String
Dim sUrlRequest, intTry As Integer, strResponse As String
Dim oXMLHTTP As Object 'MSXML2.XMLHTTP
Dim oResponse As Object 'MSXML2.XMLHTTP
'Sample usage:
' GetRateCBR(#10/12/2007#,"USD")
' GetRateCBR(#10/12/2007#,"Eur")
On Error GoTo GetRateCBR_Error

Set oResponse = CreateObject("MSXML2.DOMDocument")
'Send request
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(strCurCode = "EUR", 9, 5)
' get response
intTry = 1
Do Until intTry > 10
Set oXMLHTTP = CreateObject("MSXML2.XMLHTTP")
oXMLHTTP.Open "GET", sUrlRequest, False
oXMLHTTP.send
If oXMLHTTP.Status = 200 Then
If oResponse.loadXML(oXMLHTTP.responseText) Then Exit Do
End If
If Not oXMLHTTP Is Nothing Then _
oXMLHTTP.abort: Set oXMLHTTP = Nothing
DoEvents
intTry = intTry + 1
Loop
If Not oXMLHTTP Is Nothing Then _
oXMLHTTP.abort: Set oXMLHTTP = Nothing
If intTry <= 10 Then
strResponse = Mid$(oResponse.Text, 3)
GetRateCBR = strResponse
End If
If Not oResponse Is Nothing Then _
oResponse.abort: Set oResponse = Nothing
GetRateCBR_End:
On Error Resume Next
Exit Function

GetRateCBR_Error:
Select Case Err.Number
Case Else
MsgBox "No internet connection!" & vbCrLf & "Error " & Err.Number & " (" & Err.Description & ") in procedure GetRateCBR of Module alxmdlCurrencyRate"
Resume GetRateCBR_End
End Select

End Function

 

Technorati tags: XMLHTTP, CBR.RU, currency rate