Public Function GetCurrencyExchangeRate()
Dim rst As DAO.Recordset
Dim strSQL As String

strSQL =  "SELECT Max(tblCurrencyRates.LastUpdate) AS MaxOfLastUpdate FROM tblCurrencyRates;" 

Set rst = CurrentDb.OpenRecordset(strSQL, dbOpenSnapshot)
If Not (rst.BOF And rst.EOF) Then
    If rst!MaxOfLastUpdate = Date Then Exit Function
End If

DoCmd.Hourglass True

Dim objIE As Object
Dim objDoc As Object
Dim a As Object
Dim TDs As Object
Dim curUSD As Currency, curEUR As Currency
Dim i As Long
Dim varReturn As Variant

Set objIE = CreateObject( "InternetExplorer.Application" )
objIE.Visible = False
objIE.Silent = False
objIE.Navigate  "http://www.rbc.ru/" 

i =  1 
varReturn = SysCmd(acSysCmdInitMeter,  "Updating Currency Exchage Rates from www.rbc.ru :" ,  50000 )
While CBool(objIE.Busy)
    i = i +  1 
    varReturn = SysCmd(acSysCmdUpdateMeter, i)
    If i >  50000  Then
       DoCmd.Hourglass False
       varReturn = SysCmd(acSysCmdClearStatus)
       Exit Function
    End If
    DoEvents
Wend
varReturn = SysCmd(acSysCmdClearStatus)
            
Set objDoc = objIE.Document

For Each a In objDoc.all.tags( "A" )
    If InStr( 1 , a.href,  "/USD.rus.shtml" ) Then
        Set TDs = a.parentElement.parentElement.childNodes
        curUSD = CCur(TDs( 3 ).innerText)
        strSQL =  "INSERT INTO tblCurrencyRates ([Currency], RateDate, Rate, LastUpdate) "  & _
                  "VALUES ('R', #"  & DateValue(TDs( 2 ).innerText & _
                  "/"  & Year(Date)) &  "#, "  & curUSD &  ", #"  & Date &  "#)" 
        
        CurrentDb.Execute strSQL
    End If
    
    If InStr( 1 , a.href,  "/EUR.rus.shtml" ) Then
        Set TDs = a.parentElement.parentElement.childNodes
        curEUR = curUSD / CCur(TDs( 3 ).innerText)
        
        strSQL =  "INSERT INTO tblCurrencyRates ([Currency], RateDate, Rate, LastUpdate) "  & _
                  "VALUES ('" & Chr(128) & "', #"  & DateValue(TDs( 2 ).innerText & _
                  "/"  & Year(Date)) &  "#, "  & curEUR &  ", #"  & Date &  "#)" 
        
        CurrentDb.Execute strSQL
        Exit For
    End If
Next
objIE.Quit
Set objIE = Nothing

DoCmd.Hourglass False
End Function