[AccessD] pull data from web page

Tue Dec 19 04:42:11 CST 2006

Hi Marty

Excellent! Thanks Marty.
All you need to do is a copy/paste, add the reference to MS XML 4, and remove this line (myrs is not used):

'    Dim myrs As ADODB.Recordset

It is very fast too, and it even works in Access 97:

USD rate 1.3095
JPY rate 154.34
CYP rate 0.5781
CZK rate 27.700
DKK rate 7.4537
EEK rate 15.6466
GBP rate 0.67155
HUF rate 252.93
LTL rate 3.4528
LVL rate 0.6974
MTL rate 0.4293
PLN rate 3.7968
SEK rate 9.0555
SIT rate 239.66
SKK rate 34.839
CHF rate 1.5993
ISK rate 90.06
NOK rate 8.1410
BGN rate 1.9558
HRK rate 7.3655
RON rate 3.4185
RUB rate 34.5660
TRY rate 1.8663
AUD rate 1.6779
CAD rate 1.5114
CNY rate 10.2406
HKD rate 10.1800
IDR rate 11899.43
KRW rate 1214.10
MYR rate 4.6553
NZD rate 1.8997
PHP rate 64.604
SGD rate 2.0230
THB rate 47.022
ZAR rate 9.1727

/gustav

>>> martyconnelly at shaw.ca 14-12-2006 21:23 >>>
Here is some code to read that xml ECB rate file
Note the xpath syntax is not perfect as the xml
file contains namespaces. This means you would qualify the
element name via the namespace  [germes:Envelope]
I haven't done a lot of work with multiple namespaces
so I can't figure out the direct method of the XPath statement
either that or something is odd with the file.

Option Explicit
 Dim mcolRate As Collection

Sub testxml()
  Set mcolRate = New Collection
GrabXMLFile ("http://www.ecb.int/stats/eurofxref/eurofxref-daily.xml")
  Debug.Print mcolRate("USD")
  MsgBox "US dollar  Euro Rate ECB " & mcolRate("USD")
End Sub

Public Function GrabXMLFile(ByRef AdviserXML As String)
  'http://www.ecb.int/stats/exchange/eurofxref/html/index.en.html

'Base currency is Euro so will have to do a conversion for USD
'Note the link for other pages with sources for XML etc.
  'http://www.ecb.int/stats/eurofxref/eurofxref-daily.xml

    'On Error GoTo ErrorHandler
    'needs reference set to XML 4.0 and maybe ADO 2.8
    Dim oDOMDocument As MSXML2.DOMDocument40
    Dim oNodeList As IXMLDOMNodeList
    Dim oAdviserDetailsNode As IXMLDOMNode
    Dim oLowestLevelNode As IXMLDOMElement
    Dim oNode As IXMLDOMNode
    Dim objXMLDOMNamedNodeMap As IXMLDOMNamedNodeMap
     Dim xPError As IXMLDOMParseError
    Dim Mydb As Database
    Dim myrs As ADODB.Recordset
    Dim sTempValue As String

    Set oDOMDocument = New MSXML2.DOMDocument40

    oDOMDocument.async = False
    oDOMDocument.validateOnParse = True 'you may want to parse for errors
    oDOMDocument.resolveExternals = False
    oDOMDocument.preserveWhiteSpace = True

    'use if xml disk file
      If Not oDOMDocument.Load(AdviserXML) Then
        MsgBox ("XML File error")
             Set xPError = oDOMDocument.parseError
        DOMParseError xPError

       End If
   Set oAdviserDetailsNode = oDOMDocument.documentElement
     Debug.Print oDOMDocument.xml

   'use appropriate XPath expression to select nodes

  ' Set oNodeList = oAdviserDetailsNode.selectNodes("Envelope/Cube/Cube/@*")
  Set oNodeList = oAdviserDetailsNode.selectNodes("//@*")

     Debug.Print oNodeList.length

    For Each oNode In oNodeList

      '  Debug.Print "*" & oNode.Text; oNode.nodeName & "*"

        Select Case oNode.nodeName
            Case "currency"
                 sTempValue = oNode.Text

            Case "rate"
             'This path is used to store a variable on the collection
                On Error Resume Next
                 mcolRate.Remove sTempValue
                 mcolRate.Add oNode.Text, sTempValue
                   Debug.Print sTempValue & " rate " & oNode.Text
                On Error GoTo ErrorHandler

        End Select
      Next
    Set oNodeList = Nothing
    Set oDOMDocument = Nothing
    Set oAdviserDetailsNode = Nothing
    Set objXMLDOMNamedNodeMap = Nothing
    Exit Function

ErrorHandler:

  '  Call NewError.Raise(Err.Number, Err.Source, Err.Description)

End Function

Sub DOMParseError(xPE As IXMLDOMParseError)
    ' The document failed to load.
    Dim strErrText As String
    ' Obtain the ParseError object
    With xPE
    strErrText = "Your XML Document failed to load" & _
        "due the following error." & vbCrLf & _
        "Error #: " & .errorCode & ": " & xPE.reason & _
        "Line #: " & .Line & vbCrLf & _
        "Line Position: " & .linepos & vbCrLf & _
        "Position In File: " & .filepos & vbCrLf & _
        "Source Text: " & .srcText & vbCrLf & _
        "Document URL: " & .url
    End With
    Debug.Print strErrText
  Dim s As String
  Dim r As String
  Dim i As Long
   s = ""
  For i = 1 To xPE.linepos - 1
    s = s & " "
  Next
  r = "XML Error loading " & xPE.url & " * " & xPE.reason
  Debug.Print r
    'show character postion of error; tired of counting chars in xml file
  If (xPE.Line > 0) Then
    r = "at line " & xPE.Line & ", character " & xPE.linepos & vbCrLf & _
         xPE.srcText & vbCrLf & s & "^"
  End If
  Debug.Print r
    MsgBox strErrText, vbExclamation
End Sub

Gustav Brock wrote:

>Hi John
>
>Great! I have been looking for something like this several times without having the time to explore it.
>I'll test it some soon day - busy with real work for the moment - but Shamil or Marty will for sure pinpoint your errors(!).
>
>One comment: Note that an "exchange rate" can be many things (mid, buy, sell, averaged for customs, etc.). In your app you should probably have options for specifying one or more factors for each currency depending on the purpose(s) in the app for the exchange rate.
>
>/gustav
>
>  
>
>>>>jwcolby at colbyconsulting.com 13-12-2006 19:10 >>>
>>>>        
>>>>
>Gustav,
>
>Thanks for pointing me to the XML feed.
>
>
>  
>

-- 
Marty Connelly
Victoria, B.C.
Canada

-- 
AccessD mailing list
AccessD at databaseadvisors.com 
http://databaseadvisors.com/mailman/listinfo/accessd 
Website: http://www.databaseadvisors.com