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

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

sub ImportCurrRate_XML
 
 Set Creator = New TCreator
 Set CurrCode = CreateObject("Scripting.Dictionary")
 CurrCode.Add "USD", "USD"
 CurrCode.Add "EUR", "EUR"
 CurrCode.Add "RUB", "RUB"
 CurrCode.Add "PLN", "PLN"
 
 BaseCurrID = gdcBaseManager.GetIDByRUIDString("200010_17")
 
 Set Transaction = Creator.GetObject(null, "TIBTransaction", "")
 Set Transaction.DefaultDatabase = gdcBaseManager.Database
 
 Set ibsql = Creator.GetObject(null, "TIBSQL", "")
 Set ibsql.Transaction = Transaction
 Set ibsqlFind = Creator.GetObject(null, "TIBSQL", "")
 Set ibsqlFind.Transaction = Transaction
 
 Transaction.StartTransaction
 
 ibsql.SQL.Text =_
  "SELECT COUNT(c.code) as CountCode " &_
  "FROM gd_curr c  " &_
  "WHERE c.SHORTNAME = :C "
 
 For Each I in CurrCode
  ibsql.ParamByName("C").AsString = CurrCode.Item(I)
  ibsql.ExecQuery
  if ibsql.FieldByName("CountCode").AsInteger <> 1 then _
    CurrCode.Remove(I)
  ibsql.Close
 Next
 
 FromDate = Date + 1
 ToDate = Date + 1
 
 ibsql.SQL.Text =_
  "SELECT MAX(r.fordate) as MaxForDate " &_
  "FROM gd_currrate r JOIN gd_curr c ON r.fromcurr = c.id " &_
  "WHERE c.SHORTNAME = :FromCurr and r.tocurr = :ToCurr"
 ibsql.ParamByName("ToCurr").AsInteger = BaseCurrID
 
 For Each I in CurrCode
  ibsql.ParamByName("FromCurr").AsString = CurrCode.Item(I)
  ibsql.ExecQuery
  if ibsql.FieldByName("MaxForDate").AsDateTime < FromDate then _
    FromDate = ibsql.FieldByName("MaxForDate").AsDateTime
  ibsql.Close
 Next
 if FromDate <= CDate("01.01.2004") then _
   FromDate = CDate("01.01.2004")
 
 if ToDate < FromDate then _
  exit sub
 
 ibsql.SQL.Text = _
  "INSERT INTO gd_currrate (fromcurr, tocurr, fordate, coeff) " &_
  "SELECT ID, :TC, :FD, :R FROM gd_curr WHERE SHORTNAME = :FC "
 ibsql.ParamByName("TC").AsInteger = BaseCurrID
 
 ibsqlFind.SQL.Text =_
  "SELECT * " &_
  "FROM gd_currrate r JOIN gd_curr c ON r.fromcurr = c.id " &_
  "WHERE c.SHORTNAME = :FC and r.tocurr = :TC AND r.fordate = :FD"
 ibsqlFind.ParamByName("TC").AsInteger = BaseCurrID
 
 Set oXML = CreateObject("MSXML.DomDocument")
 oXML.async = False
 
 For D = FromDate to ToDate Step 1
   ibsqlFind.Close
   ibsqlFind.ParamByName("FD").AsDateTime = D
 
   ibsql.ParamByName("FD").AsDateTime = D
 
   On Error Resume Next
     oXML.Load ("http://www.nbrb.by/Services/XmlExRates.aspx?ondate=" &_
       Month(D) & "/" & Day(D) & "/" & Year(D))
 
     For Each I in CurrCode
 
       ibsqlFind.ParamByName("FC").AsString = CurrCode.Item(I)
       ibsqlFind.ExecQuery
       if ibsqlFind.EOF then
 
         On Error Resume Next
           ibsql.Close
           ibsql.ParamByName("R").AsCurrency = _
             CDbl(Replace(oXML.selectSingleNode("//Currency[CharCode='" & I & _
             "']/Rate").Text, ".", Application.DecimalSeparatorSys))
           ibsql.ParamByName("FC").AsString = CurrCode.Item(I)
           if Err.Number = 0 then
             ibsql.ExecQuery
             ibsql.Close
           end if
         On Error GoTo 0
       end if
       ibsqlFind.Close
     Next
   Transaction.CommitRetaining
   On Error GoTo 0
 Next
 
 Transaction.Commit
end sub