[AccessD] Exchange Rate - Currency Converter thingy

Hi All --

Here is another method for the subject task solution.
It uses XSL transformation.
Of course it's a kind of overuse of XML/XSL transformation power for this simple task but it's a generic solution for any XML/XSL transformations - just change source XML and transformation XSL...

Option Explicit
Public Sub TestMe()
'
' XML & XPath info sources
'
' http://msdn.microsoft.com/en-us/library/aa468547.aspx
' http://msdn.microsoft.com/en-us/library/aa468565
' http://social.msdn.microsoft.com/Forums/en/xmlandnetfx/thread/a3d6be0c-537a-4467-994a-1e258634ad0c
' http://www.xml.com/pub/a/1999/01/namespaces.html
' http://stackoverflow.com/questions/4550212/parsing-xml-in-vba?rq=1
'
' DOMDocument.tranformNode method information
' http://msdn.microsoft.com/en-us/library/windows/desktop/ms761399(v=vs.85).aspx
'
Dim uri As String
Dim currencyCode As String
 uri = "http://www.ecb.int/stats/eurofxref/eurofxref-daily.xml"
 currencyCode = "RUB"
 Debug.Print currencyCode + "/EUR => " + GetCurrencyRate2(currencyCode)
End Sub
Public Function GetCurrencyRate2( _
 ByVal currencyCode As String, _
 Optional ByVal uri = "http://www.ecb.int/stats/eurofxref/eurofxref-daily.xml") _
 As String
Dim xmlDoc As New MSXML2.DOMDocument30
Dim xslDoc As New MSXML2.DOMDocument30
xmlDoc.async = False
xmlDoc.Load (uri)
If (xmlDoc.parseError.ErrorCode <> 0) Then
 Err.Raise vbObjectError + 1, _
 "GetCurrencyRate2", xmlDoc.parseError.reason
Else
Dim xsl As String
 xsl = _
 "<xsl:stylesheet version='2.0' " + _
 " xmlns:xsl='http://www.w3.org/1999/XSL/Transform' " + _
 " xmlns:gesmes='http://www.gesmes.org/xml/2002-08-01' " + _
 " xmlns:ns2 ='http://www.ecb.int/vocabulary/2002-08-01/eurofxref'> " + _
 "<xsl:variable name='x1' " + _
 " select='gesmes:Envelope/ns2:Cube/ns2:Cube/ns2:Cube[@currency=""{0}""]' /> " + _
 "<xsl:template match='gesmes:Envelope'> " + _
 " [<xsl:apply-templates select='$x1' />] " + _
 "</xsl:template> " + _
 "<xsl:template match='ns2:Cube'> " + _
 " <xsl:value-of select='@rate' /> " + _
 "</xsl:template> " + _
 "</xsl:stylesheet>"
xsl = Replace(xsl, "{0}", currencyCode)
 xslDoc.async = False
 xslDoc.LoadXML (xsl)
 If (xslDoc.parseError.ErrorCode <> 0) Then
 Err.Raise vbObjectError + 1, _
 "GetCurrencyRate2", xslDoc.parseError.reason
 Else
 Dim transformedXml As String
 transformedXml = xmlDoc.transformNode(xslDoc)
 Dim pos1 As Integer
 Dim pos2 As Integer
 pos1 = InStr(transformedXml, "[")
 pos2 = InStr(transformedXml, "]")
 If (pos1 = 0 Or pos2 = 0) Then
 GetCurrencyRate2 = 0
 Else
 GetCurrencyRate2 = Mid( _
 transformedXml, pos1 + 1, pos2 - pos1 - 1)
 End If
 End If
End If
End FunctionThank you.

-- Shamil


Thu, 28 Jun 2012 18:12:08 +0400 от Salakhetdinov Shamil <mcp2004 at mail.ru>:
Hi Darren --

Here is yet another solution cooked here for you and All:

Public Function GetCurrencyRate( _
 ByVal currencyCode As String, _
 Optional ByVal uri = "http://www.ecb.int/stats/eurofxref/eurofxref-daily.xml") _
 As String<<< skipped >>>