Inefficient UDF with Internet Explorer - excel

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