Function CBR_Rate3(ByVal iCy As String, iOp As String, iDt As Date, iPt As String, iCl As String) As Double
' Получение курса валют с сайта Сбербанк-Кострома
' http://www.sberbank.ru/kostroma/ru/quotes/currencies/

' iCy   - тип валюты        (USD, EUR, GBP, SEK - КАК ПОЛУЧИТЬ ОСТАЛЬНЫЕ???)
' iOp   - тип операции      (Купить / Продать)
' iDt   - дата              (дд.мм.гггг)
' iPt   - способ оплаты     (Cash - наличный, Non_cash - безналичный)
' iCl   - категория клиента (legal - юрик, natural - физик)

' ПОЛУЧЕНИЕ ДАННЫХ
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Static XMLHTTP As Object, objRegExp As Object
If XMLHTTP Is Nothing Then
  Set XMLHTTP = CreateObject("MSXML2.ServerXMLHTTP.6.0")
End If
If objRegExp Is Nothing Then
  Set objRegExp = CreateObject("VBScript.RegExp")
  With objRegExp
    .Global = True
    .IgnoreCase = True
    .MultiLine = False
    .Pattern = "(<.*?>)+"
  End With
End If
  
  URL = "http://www.sberbank.ru/common/js/quote_table.php"
  Post = "inf_block=138&date=" & iDt & "&payment=" & iPt & "&person=" & iCl
  XMLHTTP.Open "POST", URL
  XMLHTTP.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
  XMLHTTP.Send Post
  vStr = XMLHTTP.responseText
  
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  Курс = objRegExp.Replace(Replace(Replace(vStr, "<tr>", ""), "<td", "  <td"), "")
  
  Set F = Application.WorksheetFunction
  Tmp = F.Substitute(F.Substitute(F.Trim(Right(Курс, Len(Курс) - F.Search(iCy, Курс) - 3)), " ", "<", 2), " ", ">", 2)
  Q = Left(Tmp, F.Search(" ", Tmp))
  Buy = F.Substitute(Mid(Tmp, Len(Q) + 1, F.Search("<", Tmp) - Len(Q) - 1), ".", ",") / Q
  Sell = F.Substitute(Mid(Tmp, F.Search(">", Tmp) + 1, F.Search(" (", Tmp) - F.Search(">", Tmp)), ".", ",") / Q
  If iOp = "Купить" Then CBR_Rate3 = Buy Else CBR_Rate3 = Sell

End Function
 

Sub ReferenceProperties()
  For Each ref In ThisWorkbook.VBProject.References
    If ref.IsBroken = False Then
   Debug.Print "Имя: ", ref.Name
   Debug.Print "Путь: ", ref.FullPath
   Debug.Print "Версия: ", ref.Major & "." & ref.Minor
   Debug.Print "GUID: ", ref.GUID & Chr(10)
    Else
   Debug.Print "GUIDs of broken references:"
   Debug.Print ref.GUID
    End If
  Next ref
End Sub

Sub F()

    Dim doc As MSHTML.HTMLDocument
    Dim req As MSXML2.XMLHTTP60
    Dim iElement As MSHTML.IHTMLElement
    
    Set doc = New MSHTML.HTMLDocument
    Set req = New MSXML2.XMLHTTP60
    
    req.Open "GET", "http://www.yandex.ru", False
    req.send
    
    doc.body.innerHTML = req.responseText
    Set iElement = doc.getElementById("currency")

End Sub