Public Function GetCourse(CURRENCYID As Long, onDate As Date) As Double
  On Error GoTo Err_GetCourse
    Dim xmlDoc As MSXML2.DOMDocument
    Dim xmlNode As MSXML2.IXMLDOMNode
    
    Dim i As Integer, j As Integer
    Dim strSQL As String, strVal As String, strCourse As String
    
    DoCmd.Hourglass True
    If onDate > Date +  1  Then
        DoCmd.Hourglass False
             GetCourse = - 3  'Слишком рано
        Exit Function
    End If
    'Âûáîð âàëþòû
    If CURRENCYID = GetUSDID Then     
        strVal = "USD"
    ElseIf CURRENCYID = GetEURID Then 
        strVal = "EUR"
    ElseIf CURRENCYID = GetUEID Then  
        DoCmd.Hourglass False
        GetCourse =  35     'принятый курс УЕ 
        Exit Function
    ElseIf CURRENCYID = GetRUSID Then 
        DoCmd.Hourglass False
        GetCourse =  1  
        Exit Function
    Else
        DoCmd.Hourglass False
        GetCourse = - 2                 'Неверный код валюты 
        Exit Function
    End If
    Set xmlDoc = CreateObject("MSXML2.DOMDocument")
    xmlDoc.async = False     
    If Not xmlDoc.Load("http://www.cbr.ru/scripts/XML_daily.asp?date_req=" & Format(onDate, "dd.mm.yyyy")) Then
        GetCourse = - 4 
        MsgBox ("Не грузится!")
        DoCmd.Hourglass False
        GoTo Exit_GetCourse
    End If
    Set xmlNode = xmlDoc.selectNodes("ValCurs").Item( 0 ).cloneNode(True)
    For i =  0  To xmlNode.childNodes.Length -  1 
        If xmlNode.childNodes.Item(i).childNodes.Item( 1 ).Text = strVal Then
            strCourse = xmlNode.childNodes.Item(i).childNodes.Item( 4 ).Text
            'Debug.Print strCourse
            For j =  1  To Len(strCourse) 'замена "," на "."
                If mid(strCourse, j,  1 ) = "," Then
                    Mid(strCourse, j,  1 ) = "."
                End If
            Next j
            Exit For
        End If
    Next i
    GetCourse = CDbl(strCourse)
Exit_GetCourse:
    Set xmlDoc = Nothing
    Set xmlNode = Nothing
    DoCmd.Hourglass False
    Exit Function
Err_GetCourse:
    Set xmlDoc = Nothing
    Set xmlNode = Nothing
    DoCmd.Hourglass False
    GetCourse = - 1 
End Function

Public Function XMLobhod(obj As Object, lev As Long) As String
    Dim xmlNode As MSXML2.IXMLDOMNodeList
    Dim i As Long, j As Integer
    Dim level As Long
    Set xmlNode = obj
    Dim str As String
    level = lev
    'If xmlNode. h length = 0 Then
        'Debug.Print xmlNode.Item(0).nodeName & " Level - " & level & " Len - " & xmlNode.length
   '     Exit Function
   ' End If
    
    For i =  0  To xmlNode.length -  1 
        str = ""
        If xmlNode(i).childNodes.length >  0  Then
            For j =  1  To level
                str = str + "    "
            Next j
            
            str = str & xmlNode.Item(i).nodeName & " Level - " & level & _
                  " Len - " & xmlNode.length
                  
            If xmlNode(i).childNodes.length =  1  Then
                str = str & " Type - " & xmlNode(i).childNodes( 0 ).nodeTypeString
            End If
            Debug.Print str
            Call XMLobhod(xmlNode.Item(i).childNodes, level +  1 )
        End If
    Next i
    
    'Debug.Print xmlNode.Item(0).nodeName
    
    Set xmlNode = Nothing
End Function