Загрузка курсов валют с сайта НБРБ (XML)

Предпочтительно использовать именно этот вариант, так как он не зависит визуального оформления, структуры HTML страницы.

Option Explicit
Sub Curr_LoadRates
 
 Dim Creator
 Set Creator = New TCreator
 
 Dim FromDate, ToDate
 
 ' Интервал дат (включая границы) за который
 ' загружать курсы валют в базу данных
 ' Если переменные не заполнены, то
 ' возьмем курс на следующий рабочий день
 
 If IsEmpty(FromDate) Or IsEmpty(ToDate) Then
   FromDate = Date + 1
   If Weekday(Date) <> 6 Then
     ToDate = Date + 1
   Else
     ToDate = Date + 3
   End If
 End If
 
 Dim Tr, q
 Set Tr = Creator.GetObject(nil, "TIBTransaction", "")
 Set Tr.DefaultDatabase = gdcBaseManager.Database
 Tr.StartTransaction
 Set q = Creator.GetObject(nil, "TIBSQL", "")
 Set q.Transaction = Tr
 
 ' gd_curr.code в точности, с учетом регистра, должно
 ' совпадать с тем, что идет в XML файле
 Dim CurrCode
 Set CurrCode = CreateObject("Scripting.Dictionary")
 q.SQL.Text = "SELECT code, id FROM gd_curr WHERE disabled = 0"
 q.ExecQuery
 While Not q.EOF
   If Not CurrCode.Exists(q.FieldByName("code").AsString) Then
     CurrCode.Add q.FieldByName("code").AsString, q.FieldByName("id").AsInteger
   Else
     MsgBox "В базе данных дублируется код валюты " & q.FieldByName("code").AsString
     Exit Sub
   End If
   q.Next
 WEnd
 q.Close
 
 q.SQL.Text = _
   "UPDATE OR INSERT INTO gd_currrate (fromcurr, tocurr, fordate, val, amount) " &_
   "VALUES (:fc, 200010, :fd, :val, :amount) " &_
   "MATCHING (fromcurr, tocurr, fordate) "
 
 Dim oXML
 Set oXML = CreateObject("MSXML.DomDocument")
 oXML.async = False
 
 Dim D
 For D = FromDate to ToDate Step 1
   If oXML.Load ("http://www.nbrb.by/Services/XmlExRates.aspx?ondate=" &_
     Month(D) & "/" & Day(D) & "/" & Year(D)) Then
 
     Dim nodeXML
     Set nodeXML = oXML.getElementsByTagName("DailyExRates")
 
     Dim N
     For N = 0 To nodeXML.Length - 1
       Dim N2
       For Each N2 In nodeXML.Item(N).ChildNodes
         Dim N3, J
         J = 0
 
         For Each N3 In N2.ChildNodes
           If N3.nodeName = "Scale" Then
             q.ParamByName("amount").AsInteger = N3.nodeTypedValue
             J = J + 1
           ElseIf N3.nodeName = "Rate" Then
             q.ParamByName("val").AsDouble = CDbl(Replace(N3.nodeTypedValue, ".", Application.DecimalSeparatorSys))
             J = J + 1
           ElseIf N3.nodeName = "CharCode" Then
             If CurrCode.Exists(N3.nodeTypedValue) Then
               q.ParamByName("fc").AsInteger = CurrCode.Item(N3.nodeTypedValue)
               J = J + 1
             End If
           End If
         Next
         If J = 3 Then
           'иначе произойдет потеря точности при вычислении coeff
           If q.ParamByName("amount").AsInteger <= 10000 Then
             q.ParamByName("fd").AsDateTime = D
             q.ExecQuery
           End If
         End If
       Next
     Next
   End If
 Next
 
 q.Close
 Tr.Commit
End Sub

Подключение через прокси-сервер:

Set WshShell = CreateObject("WScript.Shell")
RegKey = "HKCU\Software\Microsoft\Windows\CurrentVersion\Internet Settings"
ProxyEnabled = WshShell.RegRead(regkey & "ProxyEnable")
If ProxyEnabled Then
  ProxyIP = Split(WshShell.RegRead(regkey & "ProxyServer"), ":")(0)
  ProxyIP = CStr(ProxyIP)
  ProxyPort = Split(WshShell.RegRead(regkey & "ProxyServer"), ":")(1)
  ProxyPort = CStr(ProxyPort)
Else
  ProxyIP = ""
  ProxyPort = ""
End If