[AccessD] pull data from web page

MartyConnelly martyconnelly at shaw.ca
Thu Dec 14 14:23:33 CST 2006


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




More information about the AccessD mailing list