JWColby
jwcolby at colbyconsulting.com
Wed Dec 13 12:10:13 CST 2006
Gustav,
Thanks for pointing me to the XML feed.
The following function will load the url
http://www.ecb.int/stats/eurofxref/eurofxref-daily.xml into an XML document,
then burrow down into the xml document until it reaches the cube node, then
prints the attributes of that node (country code and rate) and finally,
returns the rate for the country passed in.
I make no claim that this is the most efficient XML parsing code in the
world as I did the whole thing in a few hours, never having seen XML code
before, but it does work.
Copy and paste the following code into a module and save as basXMLRates.
WATCH FOR LINE WRAPS IN THE CODE AND FIX THEM.
Then from the debug window type:
?GetCurr()
You will get back the USD rate relative to the Euro. Obviously you can
change the default to some other country
Type in ?GetCurr(,true) to print all the rates in the debug window as well
as the selected rate at the end
Type in ?GetCurr("JPY") to get the Japanese yen without the debug print.
To get the USD expressed in YEN type in
?getcurr("usd") / getcurr("JPY")
Etc.
'*********************
'Start here
'*********************
Option Compare Database
Option Explicit
'
'This function uses static collections to hold the country codes and their
associated rates
'I do this so that if the function is called more than once in a given day,
the second and
'subsequent times don't have to go to the web to get the rates
'
'Obviously I am not handling rate updates at a given time of day. That is
up to you.
'
Function GetCurr(Optional strCountryCode As String = "USD", Optional
blnPrint As Boolean = False) As Currency
On Error GoTo Err_GetCurr
Static colRates As Collection
Static colCountryCodes As Collection
Static dte As Date
Dim intCnt As Integer
Dim lstrCountryCode As String
Dim lcurRate As Currency
If dte <> Date Then 'Check to see if this function was run today'
dte = Date
Set colRates = New Collection 'If not then initialize the
collections again
Set colCountryCodes = New Collection
TranslateXMLCurr colCountryCodes, colRates 'and go get the rates
for the day
End If
'
'If a debug.print was requested
'
If blnPrint Then
'iterate through the country code cilletion getting the country
codes
For intCnt = 1 To colCountryCodes.Count
lstrCountryCode = colCountryCodes.Item(intCnt)
lcurRate = colRates.Item(intCnt) 'use that to get the rate
for that country
Debug.Print lstrCountryCode & " : " & lcurRate 'print both in
a string to the debug window
Next intCnt
End If
On Error Resume Next 'If the country code passed in is bogus, ignore
the error
'
'And pass back the requested rate
'
GetCurr = colRates(strCountryCode)
Exit_GetCurr:
On Error Resume Next
Exit Function
Err_GetCurr:
MsgBox Err.Description, , "Error in Function basXML.GetCurr"
Resume Exit_GetCurr
Resume 0 '.FOR TROUBLESHOOTING
End Function
'
'This function looks up rates off of a web site and loads the country codes
and rates into two collections
'
Function TranslateXMLCurr(colCountryCodes As Collection, colRates As
Collection) As Currency
On Error GoTo Err_TranslateXMLCurr
Dim fSuccess As Boolean
Dim oDoc As MSXML2.DOMDocument
Dim oRoot As MSXML2.IXMLDOMNode
Dim oCube As MSXML2.IXMLDOMNode
Dim oChild As MSXML2.IXMLDOMNode
Dim oChildren As MSXML2.IXMLDOMNodeList
Dim oAttributes As MSXML2.IXMLDOMNamedNodeMap
Dim lstrCountryCode As String
Dim lcurRate As Currency
Set oDoc = New MSXML2.DOMDocument
oDoc.async = False
oDoc.validateOnParse = False
fSuccess =
oDoc.Load("http://www.ecb.int/stats/eurofxref/eurofxref-daily.xml")
'
' If anything went wrong, quit now.
If Not fSuccess Then
GoTo Exit_TranslateXMLCurr
End If
Set oRoot = oDoc.documentElement
Set oCube = oRoot.ChildNodes(2).ChildNodes(0)
Set oChildren = oCube.ChildNodes
For Each oChild In oChildren
Set oAttributes = oChild.Attributes
With oAttributes
lstrCountryCode = .Item(0).nodeTypedValue 'Get the country
code
lcurRate = .Item(1).nodeTypedValue 'Get the current
rate
colCountryCodes.Add lstrCountryCode
colRates.Add lcurRate, lstrCountryCode
End With
Next oChild
Exit_TranslateXMLCurr:
Exit Function
Err_TranslateXMLCurr:
MsgBox Err.Description, , "Error in Function
basXML.TranslateXMLCurr"
Resume Exit_TranslateXMLCurr
Resume 0 '.FOR TROUBLESHOOTING
End Function
'*********************
'End here
'*********************
Prints in the following manner:
USD : 1.3265
JPY : 155.34
CYP : 0.5781
CZK : 27.880
DKK : 7.4534
EEK : 15.6466
GBP : 0.67280
HUF : 253.48
LTL : 3.4528
LVL : 0.6973
MTL : 0.4293
PLN : 3.8008
SEK : 9.0407
SIT : 239.68
SKK : 34.775
CHF : 1.5951
ISK : 91.76
NOK : 8.1520
BGN : 1.9558
HRK : 7.3579
RON : 3.4247
RUB : 34.7980
TRY : 1.8919
AUD : 1.6811
CAD : 1.5273
CNY : 10.3819
HKD : 10.3094
IDR : 12031.36
KRW : 1223.76
MYR : 4.7018
NZD : 1.9172
PHP : 65.536
SGD : 2.0421
THB : 46.783
ZAR : 9.2630
Enjoy.
Perhaps we could put this code up on the web site as an extreme example of
bad programming practice in general as well as an intro of how to use the
XML object, and a currency converter (at least for mostly euro currencies).
I found it fascinating that given a XML feed, I could just suck it in and
go. Of course the "going" was a tough slog never having seen the xml object
before...
John W. Colby
Colby Consulting
www.ColbyConsulting.com
-----Original Message-----
From: accessd-bounces at databaseadvisors.com
[mailto:accessd-bounces at databaseadvisors.com] On Behalf Of Gustav Brock
Sent: Wednesday, December 13, 2006 9:37 AM
To: accessd at databaseadvisors.com
Subject: Re: [AccessD] pull data from web page
Hi John
This page may be of more help (it's European ...):
http://www.ecb.int/stats/exchange/eurofxref/html/index.en.html
Base currency is Euro so will have to do a conversion for USD but that
should be easy for you.
Note the link for other pages with sources for XML etc.
XML here:
http://www.ecb.int/stats/eurofxref/eurofxref-daily.xml
If you find a nice method, please share.
/gustav