Dim xmldoc As Object
Dim dateXML As Date, dateMax As Date
On Error GoTo Err_ImportCurrency
Dim cnn As ADODB.Connection
Dim rs As ADODB.Recordset

Set cnn = CurrentProject.Connection
Set rs = New ADODB.Recordset
rs.Open "SELECT max(date) FROM currency", _
        ActiveConnection:=cnn, _
        CursorType:=adOpenStatic, _
        LockType:=adLockOptimistic
        If rs.RecordCount >  0  Then
         'rs.MoveLast 
        If rs( 0 ).value >= date Then
        rs.Close
        Set rs = Nothing
        Exit Sub
        End If
        End If
rs.Close
Set rs = Nothing
    DoCmd.Hourglass True
    Set xmldoc = CreateObject("Msxml.DOMDocument")
    xmldoc.async = False  ' флаг асинхронной загрузки документа 
     ' загружаем документ по url 
    If Not xmldoc.Load("http://www.cbr.ru/scripts/XML_daily.asp?date_req=") Then
       MsgBox ("Документ с курсом валют не загружается. Проверьте подключение к Интернету или ссылка не работает.")
       GoTo Exit_ImportCurrency
    End If
    dateXML = xmldoc.selectNodes("ValCurs").Item( 0 ).cloneNode(True).Attributes( 0 ).value
    Set xmldoc = Nothing
    dateMax = Nz(DMax("date", "Currency"), date -  740 )
    Do While dateMax < dateXML
        CurrentProject.Connection.Execute "Delete  from Valute"
        dateMax = dateMax +  1 
       ImportXML "http://www.cbr.ru/scripts/xml_daily.asp?date_req=" & Format(dateMax, "dd\.mm\.yyyy"), acAppendData
  

        CurrentProject.Connection.Execute "INSERT INTO Currency (code,cur,date) " _
        & "select NumCode, Value,'" & dateMax & "' as EXPR1 " _
        & " FROM Valute " _
        & "WHERE [NumCode] In (840,978)"
           
        CurrentProject.Connection.Execute "Delete  from  Valute"
    Loop
Exit_ImportCurrency:
DoCmd.Hourglass False
    Exit Sub

dateXML = xmldoc.selectNodes("ValCurs").Item( 0 ).cloneNode(True).Attributes( 0 ).value