<

Exchange Rates and Currency Conversion in VBA

Published on
5,235 Points
1,235 Views
Last Modified:
Editors:
When converting amounts between different currencies, you need exchange rates. This article demonstrates how to obtain these from no less than nine different sources, either for free or - for intense or demanding use - for a fee.

Services and their features


Exchange rates can be obtained from many sources, some free, some paid.


Hardly two of these serve the same purpose or are targeted the same users. This means, that some research typically is necessary to pick the service that will fit a given scenario and demand. Several factors come into play:


  • authority - rates provided by national banks have high trust
  • interface - what code is needed to retrieve the data
  • range of currencies - from and to which currencies is the demand for
  • update frequency - once a day or more often
  • costs - can a fee be accepted, or must the service be free to use


Only one factor - code examples for the interfaces - we take care of here; the rest is up to you, and you will have to visit the various websites to obtain the current details and further info before making a decision.


Services offered


The services, that this project addresses, are:


1. The European Central Bank

2. The Danish National Bank

3. The Central Bank of the Russian Federation

4. Currency Converter API

5. Currencylayer API

6. ExchangeRate API

7. Fixer

8. Open Exchange Rates

9. XE


All services support the currencies commonly used in international trade; for more exotic currencies, you may be limited in the choice of service.


For free, a few services provide exchange rates from any base currency, some provide exchange rates based on one currency only, some only one or a few currencies based on any currency, and one provides exchange rates to one currency only (Euro, The European Central Bank). One service, XE, offers no free plan or subscription at all, only a seven-day trial.


The exchange rates published by the services are what is called mid-market rates. This means, that they cannot be used for real transactions; for such, you must refer to the actual buying and selling rates of your bank or broker.


Functions


Like the services differ in offerings, so do the various APIs or download options, though only three basic techniques are used:


  1. addressing an API, delivering data as Json
  2. reading an XML document
  3. parsing an HTML document (web scraping, data extracting)


However, no two services - even using the same basic technique - offer the same data format; thus a custom function is required for each service.


The main functions offered are named:


ExchangeRatesXyz


where Xyz is a three-letter abbreviation of the service name.


Each of these functions returns an array with the rates, and also attempts to cache the download for two reasons:


  • to speed up reading the rates multiple times
  • to save the usage of and the load on the service


The returned array is simple - with three or four dimensions of various data types:


  1. Publishing date (Date)
  2. ISO currency code (Three-letter string)
  3. Exchange rate (Double)
  4. (Optional) Currency name (string)


Thus, a typical call will be:


Dim ArrayOfExhangeRates As Variant

ArrayOfExhangeRates = ExchangeRatesXyz()

The functions are supplemented with a set of matching functions for converting an amount from one currency to another. These are named in a similar way:


CurrencyConvertXyz


These functions each utilise the output from the corresponding ExchangeRatesXyz function. Further, they cache the conversion factor for a set of currencies to speed up the calculation of many amounts between the same two currencies. 


The returned value is the conversion factor between the two passed currency codes, for example:


Dim ConversionFactor As Double

ConversionFactor = CurrencyConvertXyz("BBB", AAA")

All functions support the neutral currency code XXX for an exchange rate of 1.


Early or late binding, 32- or 64-bit

Where relevant, all functions support both early and late binding. Code has been tested with both 32-bit and 64-bit Microsoft Access 2016 and Access 365.


The Json modules from the project VBA.CVRAPI are required for those functions that retrieve data as Json.


The services


1. The European Central Bank

2. The Danish National Bank


The ECB and The Danish National Bank offer a daily list of exchange rates for selected currencies, indeed all the European other than Euro. These can be downloaded as an XML file, but our functions read them directly and transform them to an array in a few steps. 


Note the use of static variables to prevent unnecessary repeated calls to the site. Effectively, the data will only be retrieved once per day. After the first call, the static array Rates, holding the exchange rates of the day, will be returned directly for all subsequent calls, speeding these up vastly.


The in-line comments explain each step, for example for the ECB:


' Retrieve the current exchange rates from the European Central Bank, ECB,
' for Euro having each of the listed currencies as the base currency.
' The rates are returned as an array and cached until the next update.
' The rates are updated once a day at about UTC 15:00.
'
' Source:
'   http://www.ecb.europa.eu/stats/policy_and_exchange_rates/euro_reference_exchange_rates/html/index.en.html
'
' Note:
'   The exchange rates on the European Central Bank's website are indicative rates
'   that are not intended to be used in any market transaction.
'   The rates are intended for information purposes only.
'
' Example:
'   Dim Rates As Variant
'   Rates = ExchangeRatesEcb()
'   Rates(7, 0) -> 2018-05-30       ' Publishing date.
'   Rates(7, 1) -> "PLN"            ' Currency code.
'   Rates(7, 2) -> 4.3135           ' Exchange rate.
'
' 2018-06-07. Gustav Brock, Cactus Data ApS, CPH.
'
Public Function ExchangeRatesEcb() As Variant

    ' Operational constants.
    '
    ' Base URL for European Central Bank exchange rates.
    Const ServiceUrl    As String = "http://www.ecb.europa.eu/stats/eurofxref/"
    ' File to look up.
    Const Filename      As String = "eurofxref-daily.xml"
    ' Update hour (UTC).
    Const UpdateHour    As Date = #3:00:00 PM#
    ' Update interval: 24 hours.
    Const UpdatePause   As Integer = 24
    
    ' Function constants.
    '
    ' Async setting.
    Const Async         As Variant = False
    ' XML node and attribute names.
    Const RootNodeName  As String = "gesmes:Envelope"
    Const CubeNodeName  As String = "Cube"
    Const TimeNodeName  As String = "Cube"
    Const TimeItemName  As String = "time"
    Const CodeItemName  As String = "currency"
    Const RateItemName  As String = "rate"
  
#If EarlyBinding Then
    ' Microsoft XML, v6.0.
    Dim Document        As MSXML2.DOMDocument60
    Dim XmlHttp         As MSXML2.ServerXMLHTTP60
    Dim RootNodeList    As MSXML2.IXMLDOMNodeList
    Dim CubeNodeList    As MSXML2.IXMLDOMNodeList
    Dim RateNodeList    As MSXML2.IXMLDOMNodeList
    Dim RootNode        As MSXML2.IXMLDOMNode
    Dim CubeNode        As MSXML2.IXMLDOMNode
    Dim TimeNode        As MSXML2.IXMLDOMNode
    Dim RateNode        As MSXML2.IXMLDOMNode
    Dim RateAttribute   As MSXML2.IXMLDOMAttribute

    Set Document = New MSXML2.DOMDocument60
    Set XmlHttp = New MSXML2.ServerXMLHTTP60
#Else
    Dim Document        As Object
    Dim XmlHttp         As Object
    Dim RootNodeList    As Object
    Dim CubeNodeList    As Object
    Dim RateNodeList    As Object
    Dim RootNode        As Object
    Dim CubeNode        As Object
    Dim TimeNode        As Object
    Dim RateNode        As Object
    Dim RateAttribute   As Object

    Set Document = CreateObject("MSXML2.DOMDocument")
    Set XmlHttp = CreateObject("MSXML2.ServerXMLHTTP")
#End If

    Static Rates()      As Variant
    Static LastCall     As Date
    
    Dim Url             As String
    Dim CurrencyCode    As String
    Dim Rate            As String
    Dim ValueDate       As Date
    Dim ThisCall        As Date
    Dim Item            As Integer
    
    
    If DateDiff("h", LastCall, UtcNow) < UpdatePause Then
        ' Return cached rates.
    Else
        ' Retrieve updated rates.
    
        ' Define default result array.
        ' Redim for three dimensions: date, code, rate.
        ReDim Rates(0, 0 To 2)
        Rates(0, RateDetail.Date) = NoValueDate
        Rates(0, RateDetail.Code) = NeutralCode
        Rates(0, RateDetail.Rate) = NeutralRate
        
        Url = ServiceUrl & Filename
        
        ' Retrieve data.
        XmlHttp.Open "GET", Url, Async
        XmlHttp.Send
        
        If XmlHttp.Status = HttpStatus.OK Then
            ' File retrieved successfully.
            Document.loadXML XmlHttp.ResponseText
        
            Set RootNodeList = Document.getElementsByTagName(RootNodeName)
            ' Find root node.
            For Each RootNode In RootNodeList
                If RootNode.nodeName = RootNodeName Then
                    Exit For
                Else
                    Set RootNode = Nothing
                End If
            Next
            
            If Not RootNode Is Nothing Then
                If RootNode.hasChildNodes Then
                    ' Find first level Cube node.
                    Set CubeNodeList = RootNode.childNodes
                    For Each CubeNode In CubeNodeList
                        If CubeNode.nodeName = CubeNodeName Then
                            Exit For
                        Else
                            Set CubeNode = Nothing
                        End If
                    Next
                End If
            End If
            If Not CubeNode Is Nothing Then
                If CubeNode.hasChildNodes Then
                    ' Find second level Cube node.
                    Set CubeNodeList = CubeNode.childNodes
                    For Each TimeNode In CubeNodeList
                        If TimeNode.nodeName = TimeNodeName Then
                            Exit For
                        Else
                            Set TimeNode = Nothing
                        End If
                    Next
                End If
            End If
            
            If Not TimeNode Is Nothing Then
                If TimeNode.hasChildNodes Then
                    ' Find value date.
                    ValueDate = CDate(TimeNode.Attributes.getNamedItem(TimeItemName).nodeValue)
                    
                    ' Find the exchange rates.
                    Set RateNodeList = TimeNode.childNodes
                    ' Redim for three dimensions: date, code, rate.
                    ReDim Rates(RateNodeList.Length - 1, 0 To 2)
                    For Each RateNode In RateNodeList
                        Rates(Item, RateDetail.Date) = ValueDate
                        If RateNode.Attributes.Length > 0 Then
                            ' Get the ISO currency code.
                            Set RateAttribute = RateNode.Attributes.getNamedItem(CodeItemName)
                            If Not RateAttribute Is Nothing Then
                                CurrencyCode = RateAttribute.nodeValue
                            End If
                            ' Get the exchange rate for this currency code.
                            Set RateAttribute = RateNode.Attributes.getNamedItem(RateItemName)
                            If Not RateAttribute Is Nothing Then
                                Rate = RateAttribute.nodeValue
                            End If
                            Rates(Item, RateDetail.Code) = CurrencyCode
                            Rates(Item, RateDetail.Rate) = CDbl(Val(Rate))
                        End If
                        Item = Item + 1
                    Next RateNode
                End If
            End If
            
            ThisCall = ValueDate + UpdateHour
            ' Record requested language and publishing time of retrieved rates.
            LastCall = ThisCall
            
        End If
    End If
    
    ExchangeRatesEcb = Rates

End Function

The corresponding conversion functions are also similar. They look up the exchange rates for the two currencies from the retrieved array, and then calculate the relation between these, for example:


' Returns the current conversion factor from Danish Krone to another currency
' based on the official exchange rates published by the Danish National Bank.
'
' Optionally, the conversion factor can be calculated from any other of the
' published exchange rates. Exchange rates for other base currencies are
' calculated from DKK by triangular calculation.
'
' Source:
'   http://www.nationalbanken.dk/en/statistics/exchange_rates/Pages/default.aspx
'
' If an invalid or unpublished currency code is passed, a conversion factor
' of zero is returned.
'
' Examples, typical:
'   CurrencyConvertDkk("EUR")           ->  0.134062634062634
'   CurrencyConvertDkk("EUR", "DKK")    ->  0.134062634062634
'   CurrencyConvertDkk("AUD")           ->  0.21661901048436
'   CurrencyConvertDkk("AUD", "DKK")    ->  0.21661901048436
'   CurrencyConvertDkk("DKK", "AUD")    ->  4.6164
'   CurrencyConvertDkk("DKK", "EUR")    ->  7.4592
'   CurrencyConvertDkk("AUD", "EUR")    ->  1.61580452300494

'   CurrencyConvertDkk("", "EUR")       ->  7.4592
'   CurrencyConvertDkk("DKK")           ->  1
' Examples, neutral code.
'   CurrencyConvertDkk("AUD", "XXX")    ->  1
'   CurrencyConvertDkk("XXX", "AUD")    ->  1
'   CurrencyConvertDkk("XXX")           ->  1
' Examples, invalid code.
'   CurrencyConvertDkk("XYZ")           ->  0
'   CurrencyConvertDkk("EUR", "XYZ")    ->  0
'
' 2018-09-24. Gustav Brock, Cactus Data ApS, CPH.
'
Public Function CurrencyConvertDkk( _
    ByVal IsoTo As String, _
    Optional ByVal IsoFrom As String = DanishKroneCode) _
    As Double
    
    Dim Rates()     As Variant
    
    Dim RateTo      As Double
    Dim RateFrom    As Double
    Dim Factor      As Double
    Dim Index       As Integer
    
    If IsoFrom = "" Then
        IsoFrom = DanishKroneCode
    End If
    If IsoTo = "" Then
        IsoTo = DanishKroneCode
    End If
    
    If IsoTo = NeutralCode Or IsoFrom = NeutralCode Then
        Factor = NeutralRate
    ElseIf IsoTo = IsoFrom Then
        Factor = NeutralRate
    Else
        Rates() = ExchangeRatesDkk
    
        If IsoTo = DanishKroneCode Then
            RateTo = NeutralRate
        Else
            For Index = LBound(Rates) To UBound(Rates)
                If Rates(Index, RateDetail.Code) = IsoTo Then
                    RateTo = Rates(Index, RateDetail.Rate)
                    Exit For
                End If
            Next
        End If
        
        If RateTo > NoRate Then
            If IsoFrom = DanishKroneCode Then
                RateFrom = NeutralRate
            Else
                For Index = LBound(Rates) To UBound(Rates)
                    If Rates(Index, RateDetail.Code) = IsoFrom Then
                        RateFrom = Rates(Index, RateDetail.Rate)
                        Exit For
                    End If
                Next
            End If
            Factor = RateFrom / RateTo
        End If
        
    End If
    
    CurrencyConvertDkk = Factor

End Function

Note, that repeated calls will be very fast, as the exchange rates will be retrieved from the cached data in function ExchangeRatesXyz.


3. The Central Bank of the Russian Federation


Exchange rates from this site are available as part of a page - a html table holding the rates. This calls for a different technique than above (for XML data) as the full page has to be retrieved and then parsed to locate the table. If success, the table is then read and converted to our array. 


Locating the publishing date takes an additional step. 


On top of this, the data must be read as a stream to be able to apply the correct character set, or the Russian names for the currencies would be garbled. ADO is used for this.


"Scraping data" as this is, is a very slow method - and risky too, as you have no guarantee that the page won't change causing the function to fail. However, currently it works well, and - as these data also will be cached - for repeated calls, it will be as fast as the other methods (XML or Json data).


Again, study the in-line comments to follow the steps taken:


' Retrieve the current exchange rates from the Central Bank of the Russian
' Federation having RUB as the base currency.
' The rates are returned as an array and cached until the next update.
' The rates are updated once a day at about UTC 13:00.
'
' Source:
'   https://cbr.ru/eng/currency_base/daily/
'
' Note:
'   The Central Bank of the Russian Federation has set the exchange rates of
'   foreign currencies against the ruble without assuming any liability to
'   buy or sell foreign currency at the rates.
'
' Example:
'   Dim Rates As Variant
'   Rates = ExchangeRatesCbr()
'   Rates(9, 0) -> 2018-10-06       ' Publishing date.
'   Rates(9, 1) -> "DKK"            ' Currency code.
'   Rates(9, 2) -> 10.2697          ' Exchange rate.
'   Rates(9, 3) -> "Danish Krone"   ' Currency name in English.
'
' 2018-10-07. Gustav Brock, Cactus Data ApS, CPH.
'
Public Function ExchangeRatesCbr( _
    Optional ByVal LanguageCode As String) _
    As Variant

    ' Operational constants.
    '
    ' API endpoints.
    Const RuServiceUrl  As String = "https://cbr.ru/currency_base/daily/"
    Const EnServiceUrl  As String = "https://cbr.ru/eng/currency_base/daily/"
    
    ' Functional constants.
    '
    ' Page encoding.
    Const Characterset  As String = "UTF-8"
    ' Async setting.
    Const Async         As Variant = False
    ' Class name of data table.
    Const DataClassName As String = "data"
    ' Field items of html table.
    Const CodeField     As Integer = 1
    Const NameField     As Integer = 3
    Const UnitField     As Integer = 2
    Const RateField     As Integer = 4
    ' Locater/header for publishing date: "DT":".
    Const DateHeader    As String = """DT"":"""
    ' Length of formatted date: 2000-01-01.
    Const DateLength    As Integer = 10
    
    ' Update hour (UTC).
    Const UpdateHour    As Date = #1:00:00 PM#
    ' Update interval: 24 hours.
    Const UpdatePause   As Integer = 24
    ' English language code.
    Const EnglishCode   As String = "en"
    ' Russion language code.
    Const RussianCode   As String = "ru"
    

#If EarlyBinding Then
    ' Microsoft XML, v6.0.
    Dim XmlHttp         As MSXML2.ServerXMLHTTP60
    ' Microsoft ActiveX Data Objects 6.1 Library.
    Dim Stream          As ADODB.Stream
    ' Microsoft HTML Object Library.
    Dim Document        As MSHTML.HTMLDocument
    Dim Scripts         As MSHTML.IHTMLElementCollection
    Dim Script          As MSHTML.HTMLHtmlElement
    Dim Tables          As MSHTML.IHTMLElementCollection
    Dim Table           As MSHTML.HTMLHtmlElement
    Dim Rows            As MSHTML.IHTMLElementCollection
    Dim Row             As MSHTML.HTMLHtmlElement
    Dim Fields          As MSHTML.IHTMLElementCollection

    Set XmlHttp = New MSXML2.ServerXMLHTTP60
    Set Stream = New ADODB.Stream
    Set Document = New MSHTML.HTMLDocument
#Else
    Dim XmlHttp         As Object
    Dim Stream          As Object
    Dim Document        As Object
    Dim Scripts         As Object
    Dim Script          As Object
    Dim Tables          As Object
    Dim Table           As Object
    Dim Rows            As Object
    Dim Row             As Object
    Dim Fields          As Object
    
    Set XmlHttp = CreateObject("MSXML2.ServerXMLHTTP")
    Set Stream = CreateObject("ADODB.Stream")
    Set Document = CreateObject("htmlfile")
#End If

    Static Rates()      As Variant
    Static LastCall     As Date
    Static LastCode     As String
    
    Dim ServiceUrl      As String
    Dim RateCount       As Integer
    Dim Published       As String
    Dim ValueDate       As Date
    Dim ThisCall        As Date
    Dim Text            As String
    Dim Index           As Integer
    Dim Unit            As Double
    Dim ScaledRate      As Double
    Dim TrueRate        As Double
    
    If StrComp(LanguageCode, RussianCode, vbTextCompare) = 0 Then
        LanguageCode = RussianCode
        ServiceUrl = RuServiceUrl
    Else
        LanguageCode = EnglishCode
        ServiceUrl = EnServiceUrl
    End If
    
    If LastCode = LanguageCode And DateDiff("h", LastCall, UtcNow) < UpdatePause Then
        ' Return cached rates.
    Else
        ' Retrieve updated rates.
    
        ' Define default result array.
        ' Redim for four dimensions: date, code, rate, name.
        ReDim Rates(0, 0 To 3)
        Rates(0, RateDetail.Date) = NoValueDate
        Rates(0, RateDetail.Code) = NeutralCode
        Rates(0, RateDetail.Rate) = NeutralRate
        Rates(0, RateDetail.Name) = NeutralName
        
        ' Retrieve data.
        XmlHttp.Open "GET", ServiceUrl, Async
        XmlHttp.Send
        If XmlHttp.Status = HttpStatus.OK Then
            ' Retrieve and convert the page.
            ' The default character set cannot be used. See:
            ' https://stackoverflow.com/a/23812869/3527297
            
            ' Write the raw bytes to the stream.
            Stream.Open
            Stream.Type = adTypeBinary
            Stream.Write XmlHttp.responseBody
            ' Read text characters from the stream applying the character set.
            Stream.Position = 0
            Stream.Type = adTypeText
            Stream.Charset = Characterset
            ' Copy the page to the document object.
            Document.body.innerHTML = Stream.ReadText
        
            ' Search the scripts to locate the publishing date.
            Set Scripts = Document.getElementsByTagName("script")
            ValueDate = Date
            For Each Script In Scripts
                Text = Script.innerHTML
                If InStr(Text, "uniDbQuery_Data =") > 0 Then
                    Published = Left(Split(Text, DateHeader)(1), DateLength)
                    If IsDate(Published) Then
                        ValueDate = CDate(Published)
                    End If
                    Exit For
                End If
            Next
        
            ' Search the tables to locate the data table.
            ' Doesn't work with late binding.
            ' Set Tables = Document.getElementsByClassName("data")
            Set Tables = Document.getElementsByTagName("table")
            For Each Table In Tables
                If Table.className = DataClassName Then
                    Exit For
                End If
            Next
            
            If Not Table Is Nothing Then
                ' The table was found.
                Set Rows = Table.getElementsByTagName("tr")
                ' Reduce the count by one to skip the header row.
                RateCount = Rows.Length - 1
                ' Redim for four dimensions: date, code, rate, name.
                ReDim Rates(0 To RateCount - 1, 0 To 3)
                
                ' Fill the array of rates.
                For Index = LBound(Rates, 1) To UBound(Rates, 1)
                    ' Offset Index by one to skip the header row.
                    Set Row = Rows.Item(Index + 1)
                    ' Get the fields of this rate.
                    Set Fields = Row.getElementsByTagName("td")
                    
                    ' The returned rates are scaled to hold four decimals only.
                    ' Calculate the true (non-scaled) rate.
                    ScaledRate = Val(Replace(Fields.Item(RateField).innerText, ",", "."))
                    Unit = Val(Fields.Item(UnitField).innerText)
                    TrueRate = ScaledRate / Unit
                    
                    Rates(Index, RateDetail.Date) = ValueDate
                    Rates(Index, RateDetail.Code) = Fields.Item(CodeField).innerText
                    Rates(Index, RateDetail.Rate) = TrueRate
                    Rates(Index, RateDetail.Name) = Fields.Item(NameField).innerHTML
                Next
            End If
            
            ThisCall = ValueDate + UpdateHour
            ' Record requested language and publishing time of retrieved rates.
            LastCode = LanguageCode
            LastCall = ThisCall
            
        End If
    End If
    
    ExchangeRatesCbr = Rates

End Function

The associated CurrencyConvertCbr function is nearly identical to the one already listed, so I won't list it here.


4. Currency Converter API


Contrary to the other services, this on supplies only one or a few specified exchange rates. For this reason - and, again, to avoid repeated calls for the same information - the retrieved exchange rates are collected in a collection. Further, for simplicity, our code will only retrieve one exchange rate per call. 


This means that if you, for example, wish to have the exchange rates for USD, RUB, and DKK against EUR, you will make three calls and, for each call, add the retrieved exchange rate information to the collection, thus "building up" the array of exchange rates returned.


Each step is carefully commented in-line to make it easy to follow the flow. Note please, that the Json data is retrieved and decoded by the functions RetrieveDataResponse and CollectJson from my project VBA.CVRAPI (link above):


' Retrieve the current exchange rate from "Currency Converter API" for one base currency.
' The requested rate is returned as an array and cached until the next update.
' All retrieved rates are cached in a collection until the next update.
' The rates are updated from once per hour down to once per minute.
'
' Default base currency is EUR.
' Default rate is for USD.
'
' Source:
'   https://currencyconverterapi.com/
'   https://currencyconverterapi.com/docs
'
' Note:
'   The services are provided as is and without warranty.
'
' Example:
'   Dim Rates As Variant
'   Rates = ExchangeRatesCca()
'   Rates(0, 0) -> 2018-09-24 07:56:50  ' Publishing date.
'   Rates(0, 1) -> "USD"                ' Currency code.
'   Rates(0, 2) -> 1.17395              ' Exchange rate.
'
' 2018-09-24. Gustav Brock, Cactus Data ApS, CPH.
'
Public Function ExchangeRatesCca( _
    Optional ByVal IsoBase As String = EuroCode, _
    Optional ByVal IsoTo As String = USDollarCode) _
    As Variant
    
    ' Operational constants.
    '
    ' API endpoint.
    Const FreeSubdomain As String = "free"
    Const PaidSubdomain As String = "api"
    Const TempSubdomain As String = "xxx"
    ' API version must be 3 or higher.
    Const ApiVersion    As String = "6"
    Const ServiceUrl    As String = "https://" & TempSubdomain & ".currencyconverterapi.com/api/v" & ApiVersion & "/convert"
    ' Data styles. For reference only; must be "ultra".
    Const CompactStyle  As String = "ultra"
    Const ExtendedStyle As String = ""
    ' Update interval: 60, 15, or 1 minutes.
    Const UpdatePause   As Integer = 60
    
    ' Function constants.
    '
    ' Default currency code. Can be any valid currency codes.
    Const DefaultBase   As String = EuroCode
    Const DefaultTo     As String = USDollarCode
    ' Node names in retrieved collection.
    Const RootNodeName  As String = "root"
    ' ResponseText when invalid currency code is passed.
    Const EmptyResponse As String = "{}"
    
    Static CodePairs    As Collection
    
    Static Rates()      As Variant
    Static LastCodePair As String
    Static LastCall     As Date
    
    Dim DataCollection  As Collection
    
    Dim Parameter()     As String
    Dim Parameters()    As String
    Dim UrlParts(1)     As String
    
    Dim Subdomain       As String
    Dim CodePair        As String
    Dim RateItem        As Variant
    Dim Index           As Integer
    Dim Url             As String
    Dim ResponseText    As String
    Dim ValueDate       As Date
    Dim ThisCall        As Date
    Dim IsCurrent       As Boolean
    
    ' Assemple code pair.
    If IsoBase = "" Then
        IsoBase = DefaultBase
    End If
    If IsoTo = "" Then
        IsoTo = DefaultTo
    End If
    CodePair = Trim(Left(UCase(IsoBase), 3)) & "_" & Trim(Left(UCase(IsoTo), 3))
    
    ' Is the current collection of rates up-to-date?
    IsCurrent = DateDiff("n", LastCall, Now) < UpdatePause
    
    If IsCurrent And LastCodePair = CodePair Then
        ' Return cached rate.
    ElseIf IsCurrent And IsCollectionItem(CodePairs, CodePair) Then
        ' Return stored rate from collection.
        Rates = CodePairs(CodePair)
        LastCodePair = CodePair
    Else
        ' Retrieve the code pair and add it to the collection of code pairs.
        If IsCurrent Then
            ' Keep the stored code pairs.
        Else
            ' Clear all stored code pairs.
            Set CodePairs = New Collection
        End If
        
        ' Set subdomain to call.
        If CcaApiId = "" Then
            ' Free plan is used.
            Subdomain = FreeSubdomain
        Else
            ' Paid plan is used.
            Subdomain = PaidSubdomain
        End If
        
        ' Define parameter array.
        ' Redim for two dimensions: name, value.
        ReDim Parameter(0 To 2, 0 To 1)
        ' Parameter names.
        Parameter(0, ParameterDetail.Name) = "q"
        Parameter(1, ParameterDetail.Name) = "compact"
        Parameter(2, ParameterDetail.Name) = "apiKey"
        ' Parameter values.
        Parameter(0, ParameterDetail.Value) = CodePair
        Parameter(1, ParameterDetail.Value) = CompactStyle
        Parameter(2, ParameterDetail.Value) = CcaApiId
        
        ' Assemble parameters.
        ReDim Parameters(LBound(Parameter, 1) To UBound(Parameter, 1))
        For Index = LBound(Parameters) To UBound(Parameters)
            Parameters(Index) = Parameter(Index, 0) & "=" & Parameter(Index, 1)
        Next
        
        ' Assemble URL.
        UrlParts(0) = Replace(ServiceUrl, TempSubdomain, Subdomain)
        UrlParts(1) = Join(Parameters, "&")
        Url = Join(UrlParts, "?")
        ' Uncomment for debugging.
        'Debug.Print Url
        
        ' Define default result array.
        ' Redim for three dimensions: date, code, rate.
        ReDim Rates(0, 0 To 2)
        Rates(0, RateDetail.Date) = NoValueDate
        Rates(0, RateDetail.Code) = NeutralCode
        Rates(0, RateDetail.Rate) = NeutralRate
        
        If RetrieveDataResponse(Url, ResponseText) = True Then
            Set DataCollection = CollectJson(ResponseText)
        End If
    
        If DataCollection Is Nothing Then
            ' Error. ResponseText holds the error code.
            ' Optional error handling.
            Select Case ResponseText
                Case HttpStatus.BadRequest
                    ' Typical for invalid api key, or API limit reached.
                Case EmptyResponse
                    ' Invalid currency code.
                Case Else
                    ' Other error.
            End Select
            ' Set "not found" return values.
            Rates(0, RateDetail.Code) = NoCode
            Rates(0, RateDetail.Rate) = NoRate
        End If
        
        If Not DataCollection Is Nothing Then
            ' The rate was retrieved.
            ' Get the UTC value date and time for the rate.
            ValueDate = UtcNow
            
            ' The retrieved rate item is an array.
            RateItem = DataCollection(RootNodeName)(CollectionItem.Data)(1)
            Rates(0, RateDetail.Date) = ValueDate
            Rates(0, RateDetail.Code) = Split(RateItem(CollectionItem.Name), "_")(1)
            Rates(0, RateDetail.Rate) = RateItem(CollectionItem.Data)
            
            ' Store this code pair in the collection of code pairs.
            CodePairs.Add Rates, CodePair
            
            Set DataCollection = Nothing
            
            ' Round the call time down to the start of the update interval.
            ThisCall = CDate(Fix(Now * 24 * 60 / UpdatePause) / (24 * 60 / UpdatePause))
            ' Record hour of retrieval.
            LastCall = ThisCall
        End If
        ' Record requested base currency.
        LastCodePair = CodePair
    End If
    
    ExchangeRatesCca = Rates

End Function

As the exchange rates are collected pair-wise in the collection, the corresponding CurrencyConvertCca is extremely simple:


' Returns the current conversion factor from one currency to another
' based on the exchange rates published by "Currency Converter API".
' By default, conversion is from Euro to another currency.
'
' If an invalid or unpublished currency code is passed, a conversion factor
' of zero is returned.
'
' Examples, typical:
'   CurrencyConvertCca("DKK")           ->  7.47139
'   CurrencyConvertCca("DKK", "EUR")    ->  7.47139
'   CurrencyConvertCca("AUD")           ->  1.61313
'   CurrencyConvertCca("AUD", "DKK")    ->  0.215908
'   CurrencyConvertCca("DKK", "AUD")    ->  4.63161
'   CurrencyConvertCca("EUR", "DKK")    ->  0.133844
'   CurrencyConvertCca("", "DKK")       ->  0.157527
'   CurrencyConvertCca("USD")           ->  1.176948
' Examples, neutral code.
'   CurrencyConvertCca("AUD", "XXX")    ->  1
'   CurrencyConvertCca("XXX", "AUD")    ->  1
'   CurrencyConvertCca("XXX")           ->  1
' Examples, invalid code.
'   CurrencyConvertCca("XYZ")           ->  0
'   CurrencyConvertCca("DKK", "XYZ")    ->  0
'
' 2018-09-24. Gustav Brock, Cactus Data ApS, CPH.
'
Public Function CurrencyConvertCca( _
    ByVal IsoTo As String, _
    Optional ByVal IsoFrom As String = EuroCode) _
    As Double
    
    Dim Rates()     As Variant
    
    Dim IsoBase     As String
    Dim Factor      As Double
    
    If IsoFrom = "" Then
        IsoFrom = EuroCode
    End If
    If IsoTo = "" Then
        IsoTo = USDollarCode
    End If
    
    If IsoTo = NeutralCode Or IsoFrom = NeutralCode Then
        Factor = NeutralRate
    ElseIf IsoTo = IsoFrom Then
        Factor = NeutralRate
    Else
        ' Retrieve the current rate.
        IsoBase = IsoFrom
        Rates() = ExchangeRatesCca(IsoBase, IsoTo)
        Factor = Rates(0, RateDetail.Rate)
    End If
    
    CurrencyConvertCca = Factor

End Function


5. Currencylayer API

6. ExchangeRate API

7. Fixer

8. Open Exchange Rates


These four services supply the exchange rates as Json data. However, the formats of the four sets of data - as well as the formats of the URL to request these, and the possible error codes - are all different, thus individualised functions are needed to retrieve the exchange rates.


That said, they are quite similar, so we will only list one here. Note please, that - for free - only ExchangeRate API offers exchanges rates for any base currency, thus - for the three others - the exchange rates for other base currencies then the fixed one, triangular calculation is implemented to still obtain useful exchange rates using a free plan/subscription. 


Other than that, the steps followed are similar to the other ExchangeRatesXyz function.


Note the second call to the service, in case an "invalid" base currency is passed - which will be the case using the free plan and a base currency other than the fixed:


' Retrieve the current exchange rates from "Currencylayer API" for one base currency.
' The rates are returned as an array and cached until the next update.
' The rates are updated from once per hour down to once per minute.
'
' Default base currency is USD.
' For the free plan, exchange rates for other base currencies are
' calculated from USD by triangular calculation.
'
' Source:
'   https://currencylayer.com/
'   https://currencylayer.com/documentation
'
' Note:
'   Exchange rates are classed as indicative rates and are accurate enough to display price estimations.
'   The rates are unsuitable for forex trading or processing cross currency settlements.
'
' Example:
'   Dim Rates As Variant
'   Rates = ExchangeRatesCla()
'   Rates(12, 0) -> 2018-09-20 08:54:06 ' Publishing date.
'   Rates(12, 1) -> "BDT"               ' Currency code.
'   Rates(12, 2) -> 84.064038           ' Exchange rate.
'
' 2018-10-07. Gustav Brock, Cactus Data ApS, CPH.
'
Public Function ExchangeRatesCla( _
    Optional ByVal IsoBase As String) _
    As Variant
    
    ' Operational constants.
    '
    ' API endpoint for the free plan.
    ' For the paid plans, https may be used.
    Const ServiceUrl    As String = "http://www.apilayer.net/api/live"
    ' Update interval: 60, 10, or 1 minutes.
    Const UpdatePause   As Integer = 60
    
    ' Function constants.
    '
    ' Default base currency code.
    Const DefaultBase   As String = USDollarCode
    ' Node names in retrieved collection.
    Const RootNodeName  As String = "root"
    Const TimeNodeName  As String = "timestamp"
    Const RateNodeName  As String = "quotes"
    Const FirstNodeName As String = "success"
    Const ErrorNodeName As String = "error"
    Const CodeNodeName  As String = "code"
    ' Error code for invalid or missing access key.
    Const KeyErrorCode  As Long = 101
    ' Error code for restricted access to base currency.
    Const BaseErrorCode As Long = 105
    ' Error code for invalid currency code.
    Const CodeErrorCode As Long = 201
    
    Static Rates()      As Variant
    Static LastCode     As String
    Static LastCall     As Date
    
    Dim DataCollection  As Collection
    
    Dim Parameters()    As String
    Dim Parameter()     As String
    Dim UrlParts(1)     As String
    
    Dim RateCount       As Integer
    Dim RateItem        As Variant
    Dim BaseRate        As Double
    Dim Index           As Integer
    Dim Url             As String
    Dim ResponseText    As String
    Dim ValueDate       As Date
    Dim ThisCall        As Date
    Dim ErrorCode       As Long
    
    If IsoBase = "" Then
        IsoBase = DefaultBase
    End If
    
    If LastCode = IsoBase And DateDiff("n", LastCall, Now) < UpdatePause Then
        ' Return cached rates.
    Else
        ' Retrieve updated rates.
        
        ' Define parameter array.
        ' Redim for two dimensions: name, value.
        ReDim Parameter(0 To 1, 0 To 1)
        ' Parameter names.
        Parameter(0, ParameterDetail.Name) = "access_key"
        Parameter(1, ParameterDetail.Name) = "source"
        ' Parameter values.
        Parameter(0, ParameterDetail.Value) = ApiApiId
        Parameter(1, ParameterDetail.Value) = IsoBase
        
        ' Assemble parameters.
        ReDim Parameters(LBound(Parameter, 1) To UBound(Parameter, 1))
        For Index = LBound(Parameters) To UBound(Parameters)
            Parameters(Index) = Parameter(Index, 0) & "=" & Parameter(Index, 1)
        Next
        
        ' Assemble URL.
        UrlParts(0) = ServiceUrl
        UrlParts(1) = Join(Parameters, "&")
        Url = Join(UrlParts, "?")
        ' Uncomment for debugging.
        ' Debug.Print Url
        
        ' Define default result array.
        ' Redim for three dimensions: date, code, rate.
        ReDim Rates(0, 0 To 2)
        Rates(0, RateDetail.Date) = NoValueDate
        Rates(0, RateDetail.Code) = NeutralCode
        Rates(0, RateDetail.Rate) = NeutralRate
        
        If RetrieveDataResponse(Url, ResponseText) = True Then
            Set DataCollection = CollectJson(ResponseText)
        Else
            ' Give up.
            Set DataCollection = Nothing
        End If
    
        If Not DataCollection Is Nothing Then
            If DataCollection(RootNodeName)(CollectionItem.Data)(1)(CollectionItem.Name) = FirstNodeName Then
                If DataCollection(RootNodeName)(CollectionItem.Data)(FirstNodeName)(CollectionItem.Data) = False Then
                    ErrorCode = DataCollection(RootNodeName)(CollectionItem.Data)(ErrorNodeName)(CollectionItem.Data)(CodeNodeName)(CollectionItem.Data)
                    Select Case ErrorCode
                        Case KeyErrorCode
                            ' Missing or invalid access key.
                            Set DataCollection = Nothing
                        Case CodeErrorCode, BaseErrorCode
                            ' Typical for invalid currency code, or if free license and base <> USD, respectively.
                            ' Rebuld Url to use base = USD.
                            Parameter(1, 1) = DefaultBase
                            ' Reassemble parameters.
                            For Index = LBound(Parameters) To UBound(Parameters)
                                Parameters(Index) = Parameter(Index, 0) & "=" & Parameter(Index, 1)
                            Next
                            
                            ' Reassemble URL.
                            UrlParts(0) = ServiceUrl
                            UrlParts(1) = Join(Parameters, "&")
                            Url = Join(UrlParts, "?")
                            
                            ' Try once more to retrieve the rates.
                            If RetrieveDataResponse(Url, ResponseText) = True Then
                                Set DataCollection = CollectJson(ResponseText)
                                If DataCollection(RootNodeName)(CollectionItem.Data)(FirstNodeName)(CollectionItem.Data) = False Then
                                    ' Give up.
                                    Set DataCollection = Nothing
                                End If
                            End If
                            ' Rebuld Url to use base = USD.
                            Parameter(1, 1) = DefaultBase
                            ' Reassemble parameters.
                            For Index = LBound(Parameters) To UBound(Parameters)
                                Parameters(Index) = Parameter(Index, 0) & "=" & Parameter(Index, 1)
                            Next
                            
                            ' Reassemble URL.
                            UrlParts(0) = ServiceUrl
                            UrlParts(1) = Join(Parameters, "&")
                            Url = Join(UrlParts, "?")
                            
                            ' Try once more to retrieve the rates.
                            If RetrieveDataResponse(Url, ResponseText) = True Then
                                Set DataCollection = CollectJson(ResponseText)
                                If DataCollection(RootNodeName)(CollectionItem.Data)(FirstNodeName)(CollectionItem.Data) = False Then
                                    ' Give up.
                                    Set DataCollection = Nothing
                                End If
                            End If
                    End Select
                End If
            End If
        End If
        
        If Not DataCollection Is Nothing Then
            ' Rates were retrieved.
            ' Get the UTC value date and time for the rates.
            ValueDate = DateUnix(DataCollection(RootNodeName)(CollectionItem.Data)(TimeNodeName)(CollectionItem.Data))
            ' Get count of rates.
            RateCount = DataCollection(RootNodeName)(CollectionItem.Data)(RateNodeName)(CollectionItem.Data).Count
            ' Redim for three dimensions: date, code, rate.
            ReDim Rates(RateCount - 1, 0 To 2)
            BaseRate = NeutralRate
    
            ' Fill the array from the collection items.
            For Index = 1 To RateCount
                ' A retrieved rate item is an array.
                RateItem = DataCollection(RootNodeName)(CollectionItem.Data)(RateNodeName)(CollectionItem.Data)(Index)
                Rates(Index - 1, RateDetail.Date) = ValueDate
                Rates(Index - 1, RateDetail.Code) = Right(RateItem(CollectionItem.Name), 3)
                Rates(Index - 1, RateDetail.Rate) = RateItem(CollectionItem.Data)
                If Right(RateItem(CollectionItem.Name), 3) = IsoBase And RateItem(CollectionItem.Data) <> NeutralRate Then
                    ' Prepare triangular calculation.
                    BaseRate = RateItem(CollectionItem.Data)
                End If
            Next
            If BaseRate <> NeutralRate Then
                For Index = 1 To RateCount
                    ' Perform triangular calculation of the exchange rates.
                    If Rates(Index - 1, RateDetail.Code) = IsoBase Then
                        Rates(Index - 1, RateDetail.Rate) = NeutralRate
                    Else
                        Rates(Index - 1, RateDetail.Rate) = Rates(Index - 1, RateDetail.Rate) / BaseRate
                    End If
                Next
            End If
            
            Set DataCollection = Nothing
            
            ' Round the call time down to the start of the update interval.
            ThisCall = CDate(Fix(Now * 24 * 60 / UpdatePause) / (24 * 60 / UpdatePause))
            ' Record requested base currency and hour of retrieval.
            LastCode = IsoBase
            LastCall = ThisCall
        End If
    End If
    
    ExchangeRatesCla = Rates

End Function

The matching ConvertCurrencyXyz functions are similar to the first listed above, so please go to the code to study the minor differences.


9. XE


The API of the XE service is extended compared to the other services - for example, are average exchange rates for a period offered. That comes for a price, as no free plan is offered. If you only wish to check it out, obtain a free trial, and you have seven days; from then on, you'll have to pay.


Due to the complexity of the API, our ExchangeRatesXec function is slightly extended compared to the other functions handling Json data, because the retrieved data contains not only exchange rates but sets of exchange rates for each currency. To make the function comparable to the other ExchangeRateXyz functions, we only deal with the mid-market rates, but still.


Anyway, if you have the budget and a need for some of the more special options and offerings from XE, the function here will provide a good starting point.


As for the other functions, the in-line comments will guide you through the steps taken:


' Retrieve the current exchange rates from "XE" for one base currency.
' The rates are returned as an array and cached until the next update.
' The rates are updated from once per day down to once per minute.
'
' Default base currency is USD.
'
' Source:
'   https://www.xe.com/
'   https://www.xe.com/xecurrencydata/
'
' Note:
'   Exchange rates are live mid-market rates, which are not available to
'   consumers and are for informational purposes only.
'
' Example:
'   Dim Rates As Variant
'   Rates = ExchangeRatesXec()
'   Rates(12, 0) -> 2018-10-12 00:00:00 ' Publishing date.
'   Rates(12, 1) -> "BDT"               ' Currency code.
'   Rates(12, 2) -> 83.7886823907       ' Exchange rate.
'
' 2018-10-16. Gustav Brock, Cactus Data ApS, CPH.
'
Public Function ExchangeRatesXec( _
    Optional ByVal IsoBase As String) _
    As Variant
    
    ' Operational constants.
    '
    ' API endpoint.
    Const ServiceUrl    As String = "https://xecdapi.xe.com/v1/convert_from/"
    ' Update interval: 60, 30, or 5 minutes.
    Const UpdatePause   As Integer = 60
    
    ' Function constants.
    '
    ' Default base currency code.
    Const DefaultBase   As String = USDollarCode
    ' Node names in retrieved collection.
    Const RootNodeName  As String = "root"
    Const TimeNodeName  As String = "timestamp"
    Const RateNodeName  As String = "to"
    Const CodeNodeName  As String = "quotecurrency"
    Const ValueNodeName As String = "mid"
    
    Static Rates()      As Variant
    Static LastCode     As String
    Static LastCall     As Date
    
    Dim DataCollection  As Collection
    
    Dim Parameter()     As String
    Dim Parameters()    As String
    Dim UrlParts(1)     As String
    
    Dim UserName        As String
    Dim Password        As String
    
    Dim RateCount       As Integer
    Dim RateItem        As Variant
    Dim BaseRate        As Double
    Dim Index           As Integer
    Dim Url             As String
    Dim ResponseText    As String
    Dim ValueDate       As Date
    Dim ThisCall        As Date
    
    If IsoBase = "" Then
        IsoBase = DefaultBase
    End If
    
    If LastCode = IsoBase And DateDiff("n", LastCall, UtcNow) < UpdatePause Then
        ' Return cached rates.
    Else
        ' Retrieve updated rates.
        
        ' Define parameter array.
        ' Redim for two dimensions: name, value.
        ReDim Parameter(0 To 1, 0 To 1)
        ' Parameter names.
        Parameter(0, ParameterDetail.Name) = "from"
        Parameter(1, ParameterDetail.Name) = "to"
        ' Parameter values.
        Parameter(0, ParameterDetail.Value) = IsoBase
        Parameter(1, ParameterDetail.Value) = "*"
        
        ' Assemble parameters.
        ReDim Parameters(LBound(Parameter, 1) To UBound(Parameter, 1))
        For Index = LBound(Parameters) To UBound(Parameters)
            Parameters(Index) = Parameter(Index, 0) & "=" & Parameter(Index, 1)
        Next
        
        ' Assemble URL.
        UrlParts(0) = ServiceUrl
        UrlParts(1) = Join(Parameters, "&")
        Url = Join(UrlParts, "?")
        ' Uncomment for debugging.
        ' Debug.Print Url
        
        ' Credentials.
        UserName = XeAccount
        Password = XeApiId
        
        ' Define default result array.
        ' Redim for three dimensions: date, code, rate.
        ReDim Rates(0, 0 To 2)
        Rates(0, RateDetail.Date) = NoValueDate
        Rates(0, RateDetail.Code) = NeutralCode
        Rates(0, RateDetail.Rate) = NeutralRate
                
        If RetrieveDataResponse(Url, ResponseText, , UserName, Password) = True Then
            Set DataCollection = CollectJson(ResponseText)
        Else
            ' Check error codes.
            Select Case Left(ResponseText, 3)
                Case HttpStatus.Forbidden
                    ' Invalid credentials.
                Case HttpStatus.BadRequest
                    ' Invalid currency code (typical).
            End Select
            ' No rates were received.
            Set DataCollection = Nothing
        End If
    
        If Not DataCollection Is Nothing Then
            ' Rates were retrieved.
            ' Get the UTC value date and time for the rates.
            ValueDate = DateIso8601(DataCollection(RootNodeName)(CollectionItem.Data)(TimeNodeName)(CollectionItem.Data))
            ' Get count of rates.
            RateCount = DataCollection(RootNodeName)(CollectionItem.Data)(RateNodeName)(CollectionItem.Data).Count
            ' Redim for three dimensions: date, code, rate.
            ReDim Rates(RateCount - 1, 0 To 2)
            BaseRate = NeutralRate
    
            ' Fill the array from the collection items.
            For Index = 1 To RateCount
                ' A retrieved rate item is yet a collection with an array.
                RateItem = DataCollection(RootNodeName)(CollectionItem.Data)(RateNodeName)(CollectionItem.Data)(Index)
                Rates(Index - 1, RateDetail.Date) = ValueDate
                Rates(Index - 1, RateDetail.Code) = RateItem(CollectionItem.Data)(CodeNodeName)(CollectionItem.Data)
                Rates(Index - 1, RateDetail.Rate) = RateItem(CollectionItem.Data)(ValueNodeName)(CollectionItem.Data)
            Next
            
            Set DataCollection = Nothing
            
            ' Round the call time down to the start of the update interval.
            ThisCall = CDate(Fix(Now * 24 * 60 / UpdatePause) / (24 * 60 / UpdatePause))
            ' Record requested base currency and hour of retrieval.
            LastCode = IsoBase
            LastCall = ThisCall
        End If
    End If
    
    ExchangeRatesXec = Rates

End Function

The accompanying CurrencyConvertXec function is similar to the other CurrencyConvertXyz functions, so I won't list it here.


Supporting functions


A few trivial supporting date functions are used in some of the exchange rate functions. They will not be listed here, but can all be found in the supplemental modules included in the repository and the attached demo application.


Storing exchange rates


In many cases, you will simply wish to maintain a table with current (and past) exchange rates.


This can easily be done - using the array of rates returned from any of the ExchangeRatesXyz functions.

A simple function, that demonstrates this, is included - either to be used as is or for a starting point:


' Fill table CurrencyRate with exchange rates from a source of choice.
'
' Example:
'
'   FillCurrencyRates ExchangeRatesDkk
'
' Note, that some sources don't supply the currency name, only the code.
'
' 2018-10-07. Gustav Brock, Cactus Data ApS, CPH.
'
Public Sub FillCurrencyRates(ByRef Rates As Variant)

    Const TableName     As String = "CurrencyRate"
    
    Dim Records         As DAO.Recordset
    
    Dim FieldNames      As Variant
    Dim Sql             As String
    Dim Index           As Integer
    Dim Item            As Integer
    
    If Not IsArray(Rates) Then Exit Sub
    
    ' Field names must match the order of array Rates.
    FieldNames = Array("[Date]", "[Code]", "[Rate]", "[Name]")
    
    ' Clean table.
    Sql = "Delete * From " & TableName & ";"
    CurrentDb.Execute Sql
    
    ' Fill table.
    Sql = "Select " & Join(FieldNames, ",") & " From " & TableName & ";"
    Set Records = CurrentDb.OpenRecordset(Sql)
    For Index = LBound(Rates, 1) To UBound(Rates, 1)
        Records.AddNew
        For Item = LBound(Rates, 2) To UBound(Rates, 2)
            Records.Fields(Item).Value = Rates(Index, Item)
        Next
        Records.Update
    Next
    Records.Close
    
End Sub

A table for the purpose, CurrencyRate, is included as well for you to check out.


Conclusion


Extensive code has been provided for retrieving, using, and storing currency exchange rates from nine different sources - some free, some paid - using three basic methods for reading data off the internet.


As more services may become available, it should be easy to modify one or more of these functions to match a new service. 


Further reading


My previous article about currency may prove useful: ISO 4217 Currency Codes in VBA


Code modules and demo application

 

Code has been tested with both 32-bit and 64-bit Microsoft Access 2016 and 365

Please note, that it requires the Json modules from project VBA.CVRAPI.

 

A demo in Microsoft Access 2016 is attached: CurrencyExchange 1.5.3.zip

 

The current code can at any time be obtained from GitHub: VBA.CurrencyExchange



0
Ask questions about what you read
If you have a question about something within an article, you can receive help directly from the article author. Experts Exchange article authors are available to answer questions and further the discussion.
Get 7 days free