Inefficient UDF with Internet Explorer

Question

The below UDF opens IE and returns the currency conversion rate from USD to the input (another currency ticker i.e. EUR, GBP, HKD, etc.) For instance, if the input was ConvertUSD(USD), the output would be 1 since 1USD = 1USD.

Using the equation once is fine, the issue im having is related to the way I intend to use the function. I need to build a table with Currency tickers spanning Col A (known values and will be text). Col B will then show the corresponding rows conversion rate. I intend to set B2 = ConvertUSD(A2), and then drag this down to the bottom row (roughly 48 currencies so ending row = B49). When I do this, 48 IE windows will be opened and closed which is not ideal, but I am unsure how to avoid this.

How to create this table with just one instance of IE being opened?

Public Function ConvertUSD(ConvertWhat As String) As Double

'References
'   Microsoft XML, vs.0
'   Microsoft Internet Controls
'   Microsoft HTML Object Library.

Dim IE As New InternetExplorer
'IE.Visible = True

IE.Navigate "https://www.oanda.com/currency/converter?quote_currency=USD&base_currency=" & ConvertWhat

Do
    DoEvents
Loop Until IE.ReadyState = ReadyState_Complete
Dim Doc As HTMLDocument
Set Doc = IE.Document
Dim Ans As String
Ans = Trim(Doc.getElementsByTagName("tbody")(2).innerText)
Dim AnsExtract As Variant
AnsExtract = Split(Ans, " ")

ConvertUSD = AnsExtract(4)

IE.Quit

End Function

Answer 1

I think a more efficient method would be to use one of the sites that provides api access to this kind of data. There are a number of both free and paid sites available. The routine below (which makes use of a free api) will download and write to a worksheet 170 foreign currencies in a fraction of a second and does not open ANY IE windows. For this download, I have specified USD as the base currency, but you can specify any base.

The output from the website is as a JSON, so a JSON parser will be of value. I used the free one available at:

 VBA-JSON v2.2.3
 (c) Tim Hall - https://github.com/VBA-tools/VBA-JSON

but there are others that run in VBA. Or you can write your own.

This also requires a reference to be set to Microsoft winHTTP Services, Version 5.1 (or you could use late binding)

Option Explicit
Sub latestForex()
    Const app_id As String = "your_own_api_key"
    Const sURL1 As String = "https://openexchangerates.org/api/latest.json"
    Const sURL2 As String = "?app_id="
    Const sURL3 As String = "&base=USD"

    Dim sURL As String   
    Dim vRes As Variant, wsRes As Worksheet, rRes As Range
    Dim v, w, i As Long  
    Dim httpRequest As WinHttpRequest
    Dim strJSON As String, JSON As Object

    sURL = sURL1 & sURL2 & app_id & sURL3

    Set httpRequest = New WinHttpRequest
    With httpRequest
        .Open "Get", sURL
        .send
        .WaitForResponse
        strJSON = .responseText
    End With

    Set httpRequest = Nothing  
    Set JSON = ParseJson(strJSON)

    i = 0
    ReDim vRes(0 To JSON("rates").Count, 1 To 2)

    Set wsRes = Worksheets("sheet3")
    Set rRes = wsRes.Cells(1, 1)

    vRes(0, 1) = (JSON("timestamp") / 86400) + #1/1/1970# 'UTC time
    vRes(0, 2) = JSON("base")

    For Each v In JSON("rates")
        i = i + 1
        vRes(i, 1) = v
        vRes(i, 2) = JSON("rates")(v)
    Next v

    Set rRes = rRes.Resize(UBound(vRes, 1) + 1, UBound(vRes, 2))
    With rRes
        .EntireColumn.Clear
        .Value2 = vRes
        .Cells(1, 1).NumberFormat = "dd-mmm-yyyy hh:mm"
        .Columns(2).NumberFormat = "$0.0000"
        .EntireColumn.AutoFit
    End With
End Sub

Here is a portion of the results. Note that the time stamp is UTC. Obviously you can change that to local time.

Answer 2

Don't use a UDF. Just use a sub/macro to refresh the whole list on demand.

Do it like this:

Sub RefreshCurrencyRates()
    ' Run this sub as a macro. Use a keyboard shortcut or a button to invoke it.
    ' You can even add a call to the sub in the Workbook_Open event if you like.
    ' This sub assumes that the relevant sheet is the active sheet. This will always be the case is you use a
    ' button placed on the sheet itself. Otherwise, you might want to add further code to specify the sheet.
    '
    ' Best practice:
    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
        .DisplayAlerts = False
        .EnableEvents = False
    End With
    '
    ' The first thing you need to do is specify the range of rows which contain your currency codes.
    ' I'm hard-coding this here, but you can change it.
    ' As a first example, let's assume that you have the following currencies in cells A1-A4:
    ' A1 = GBP
    ' A2 = EUR
    ' A3 = HKD
    ' A4 = JPY
    '
    ' So with rows 1-4, we'll do the following:
    Dim RowNum As Long, CurCode As String
    ' Set up our Internet Explorer:
    Dim IE As InternetExplorer
    Set IE = New InternetExplorer
    '
    For RowNum = 1 To 4
        CurCode = Cells(RowNum, 1).Value ' Takes the currency code from column A in each row
        Cells(RowNum, 2).Value = ConvertUSD(CurCode, IE) ' Gets the relevant conversion and enters it into column B
    Next RowNum
    ' Cleardown
    IE.Quit
    Set IE = Nothing
    With Application
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
        .DisplayAlerts = True
        .EnableEvents = True
    End With
End Sub

Public Function ConvertUSD(ByVal ConvertWhat As String, IE As InternetExplorer) As Double
    'References
    '   Microsoft XML, vs.0
    '   Microsoft Internet Controls
    '   Microsoft HTML Object Library.
    IE.Navigate "https://www.oanda.com/currency/converter?quote_currency=USD&base_currency=" & ConvertWhat

    Do
        DoEvents
    Loop Until IE.ReadyState = ReadyState_Complete
    Dim Doc As HTMLDocument
    Set Doc = IE.Document
    Dim Ans As String
    Ans = Trim(Doc.getElementsByTagName("tbody")(2).innerText)
    Dim AnsExtract As Variant
    AnsExtract = Split(Ans, " ")
    ConvertUSD = AnsExtract(4)
End Function