[AccessD] XQuery in VB 6

Hi Marty

Thanks! Great example.
Seems to work fine even with XML 3.0.

/gustav

>>> martyconnelly at shaw.ca 20-04-2007 03:02 >>>
Option Compare Database
Option Explicit

Dim mcolRate As Collection
Sub testxml()
  Set mcolRate = New Collection
'find daily US dollar fixed rate vs Euro from Euro Central Bank
' via XPath

GrabXMLFile ("http://www.ecb.int/stats/eurofxref/eurofxref-daily.xml")

Debug.Print mcolRate("USD")
MsgBox "US 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