VBA obtain online currency

Question

Recently I just realized the yahoo finance (.csv) had been shut down, and leading I cannot do the online currency (update) in my excel. Hence I tried to use the below method to do my work.

1) Website: http://www.google.com/search?q="A"+to+"B"/

2) As I had noticed that the currency rate will be shown in the div class="dDoNo vk_bk"

Below is the work I am trying to do.

Option Explicit

Function OnlineCurrency(current_country As String, to_country As String) As String
Dim HTTP As MSXML2.XMLHTTP60
Dim URL As String
Dim HTMLDoc As New HTMLDocument
URL = "http://www.google.com/search?q=HKD+to+USD"
Set HTTP = New MSXML2.XMLHTTP60
HTTP.Open "GET", URL, False
HTTP.send
Set HTMLDoc = New HTMLDocument

With HTMLDoc
  .body.innerHTML = HTTP.responseText
  OnlineCurrency = .getElementByClassName("dDoNo vk_bk").innerText
End With

End Function

But seems I cannot show anything about that. Can someone help me / point out the problems for me? Thanks

The above will error for starters due to spelling mistakes _current_country_ and that getElementByClass does not exist as a method. please supply test values for both function params. Depending on excel version you may also want Dim HTTP As MSXML2.XMLHTTP60 — QHarr, Jul 18 '19 at 07:19
An example full url string would also be helpful. And definitely a link to the page where you are have already successfully seen a value you want to retrieve — QHarr, Jul 18 '19 at 07:28
@PatrickHonorez Thanks for the suggestion, but I will rather not to use API to call down the data. As API has several limitations (e.g. 500 requests per day), and that may cause trouble in the future. — kenrick tam, Jul 18 '19 at 07:48
@QHarr Thanks for your recommendation, I should have checked my work again before I posted it. Is there a way for me to check if I had already connected to the website with the above coding. — kenrick tam, Jul 18 '19 at 07:50
Yes.Check the response status code with if .status =200 then success — QHarr, Jul 18 '19 at 07:51
I see access is denied. You need to automate browser and use that url or try xmlhttp to the endpoint that the webpage actually uses which you can find via dev tools. — QHarr, Jul 18 '19 at 08:00
will you be doing this frequently for large numbers of currencies to retrieve different rates? — QHarr, Jul 18 '19 at 08:02
@QHarr I had just tested with HTTP.Status, And seems google don't like me, it feedback 403 error... — kenrick tam, Jul 18 '19 at 08:05
@QHarr Yes I will use this frequently for large number of currencies in the future. — kenrick tam, Jul 18 '19 at 08:06

Florent B. · Accepted Answer · 2019-07-23T10:35:50.367

There are many services around offering the currency rates for free.

If your goal is to get/convert the rates with an UDF, then consider caching the rates to avoid being kicked off by the service due to too many requests.

Here's an UDF using caching to efficiently convert a currency with the rates from the European Central Bank (daily updated):

''
' UDF to convert a currency using the daily updated rates fron the European Central Bank  '
'  =ConvCurrency(1, "USD", "GBP")                                                         '
''
Public Function ConvCurrency(Value, fromSymbol As String, toSymbol As String)
  Static rates As Collection, expiration As Date  ' cached / keeps the value between calls '

  If DateTime.Now > expiration Then
    Dim xhr As Object, node As Object
    expiration = DateTime.Now + DateTime.TimeSerial(1, 0, 0) ' + 1 hour '

    Set rates = New Collection
    rates.Add 1#, "EUR"

    Set xhr = CreateObject("Msxml2.ServerXMLHTTP.6.0")
    xhr.Open "GET", "https://www.ecb.europa.eu/stats/eurofxref/eurofxref-daily.xml", False
    xhr.Send

    For Each node In xhr.responseXML.SelectNodes("//*[@rate]")
      rates.Add Conversion.Val(node.GetAttribute("rate")), node.GetAttribute("currency")
    Next
  End If

  ConvCurrency = (Value / rates(fromSymbol)) * rates(toSymbol)
End Function

If you prefer the mid-market live rates, this example takes the rates from www.freeforexapi.com

''
' UDF to convert a currency using the mid-market live rates from www.freeforexapi.com     '
'  =ConvCurrency(1, "USD", "GBP")                                                     '
''
Public Function ConvCurrency(Value, fromSymbol As String, toSymbol As String)
  Static rates As Collection, expiration As Date  ' cached / keeps the value between calls '

  Const SYMBOLS = "AED,AFN,ALL,AMD,ANG,AOA,ARS,ATS,AUD,AWG,AZM,AZN,BAM,BBD,BDT,BEF,BGN,BHD,BIF,BMD,BND,BOB,BRL,BSD,BTN,BWP,BYN,BYR,BZD,CAD,CDF,CHF,CLP,CNH,CNY,COP,CRC,CUC,CUP,CVE,CYP,CZK,DEM,DJF,DKK,DOP,DZD,EEK,EGP,ERN,ESP,ETB,EUR,FIM,FJD,FKP,FRF,GBP,GEL,GGP,GHC,GHS,GIP,GMD,GNF,GRD,GTQ,GYD,HKD,HNL,HRK,HTG,HUF,IDR,IEP,ILS,IMP,INR,IQD,IRR,ISK,ITL,JEP,JMD,JOD,JPY,KES,KGS,KHR,KMF,KPW,KRW,KWD,KYD,KZT,LAK,LBP,LKR,LRD,LSL,LTL,LUF,LVL,LYD,MAD,MDL,MGA,MGF,MKD,MMK,MNT,MOP,MRO,MRU,MTL,MUR,MVR,MWK,MXN,MYR,MZM,MZN,NAD,NGN,NIO,NLG,NOK,NPR,NZD,OMR,PAB,PEN,PGK,PHP,PKR,PLN,PTE,PYG,QAR,ROL,RON,RSD,RUB,RWF,SAR,SBD,SCR,SDD,SDG,SEK,SGD,SHP,SIT,SKK,SLL,SOS,SPL,SRD,SRG,STD,STN,SVC,SYP,SZL,THB,TJS,TMM,TMT,TND,TOP,TRL,TRY,TTD,TVD,TWD,TZS,UAH,UGX,USD,UYU,UZS,VAL,VEB,VEF,VES,VND,VUV,WST,XAF,XAG,XAU,XBT,XCD,XDR,XOF,XPD,XPF,XPT,YER,ZAR,ZMK,ZMW,ZWD"

  If DateTime.Now > expiration Then
    Dim xhr As Object, re As Object, match As Object
    expiration = DateTime.Now + DateTime.TimeSerial(0, 1, 0) ' + 1 minute '

    Set rates = New Collection

    Set xhr = CreateObject("Msxml2.ServerXMLHTTP.6.0")
    xhr.Open "GET", "https://www.freeforexapi.com/api/live?pairs=USD" & Replace(SYMBOLS, ",", ",USD"), False
    xhr.Send

    Set re = CreateObject("VBScript.RegExp")
    re.Global = True
    re.Pattern = """USD([A-Z]{3})"".*?""rate"":([\d.]+)"

    For Each match In re.Execute(xhr.responseText)
        rates.Add Conversion.Val(match.SubMatches.Item(1)), match.SubMatches.Item(0)
    Next
  End If

  ConvCurrency = (Value / rates(fromSymbol)) * rates(toSymbol)
End Function

May I ask why it is required to + 1 hour through the timestamp? — kenrick tam, Jul 22 '19 at 02:54
And I had noticed that the currency will only update on around 16:00 CET every working day. Therefore it may cause the data inaccurate (compare to other converters). — kenrick tam, Jul 22 '19 at 03:01
@kenrick tam, the `+ 1 hour ` represents the lifespan of the cached rates. It will request the service at most once every hour. I added another example to get the mid-market live rates. — Florent B., Jul 22 '19 at 12:49

QHarr · Answer 2 · 2019-07-18T08:37:38.123

tl;dr

Your current construct yields permission denied. That endpoint is likely not intended for public access. Also, looking at what the page actually does to retrieve info, the set-up definitely looks like it is intended to prevent scraping
You also want more descriptive titles for variables and subs/functions
If performing for large numbers you don't want to use a function which creates an xmlhttp/IE object each time. You want to pass the xmlhttp/IE object as an argument to a function or work with it in a loop during a sub.

My recommendations would be as follows:

Use an API where possible. Have a look at the different APIs available. @PatrickHonerez refers to https://www.alphavantage.co/ which is useful. I make reference to that site here. The code at the link is an idea of how you could go about setting up a class to hold your xmlhttp object where issuing large numbers of requests.
Assuming not against T&Cs of service: If number of requests is an issue for API call (do you really need more than 500 requests per day? Do they support bulk conversions?) then you can look at automating IE and use a sub to run for all requests in a loop. This shows you the basic idea of reading values from sheet (in your case From and To ) and passing to .Navigate. You would instead have a 2D array where first column might be From and second column To. You would access those values from the array in a loop and concatenate into

url = "http://www.google.com/search?q=" & myarray(r, 1) & "+to+" & myarray(r, 2)  '< where r is the current counter position in loop

Store results in an array and write out in one go at end. A basic structure might look like:

Public Sub test()
    Dim ie As InternetExplorer, url As String, inputs(), outputs(), ws As Worksheet, r As Long

    Set ws = ThisWorkbook.Worksheets("Sheet1")
    inputs = ws.Range("A2:B20")                  '< Range containing input values column A with from and column B with to
    ReDim outputs(1 To UBound(inputs, 1))        'size output array to number of rows read in from sheet
    Set ie = New InternetExplorer
    With ie
        .Visible = True
        For r = LBound(inputs, 1) To UBound(inputs, 1)
            url = "http://www.google.com/search?q=" & from_currency & "+to+" & to_currency '"HKD", "USD"
            .Navigate2 url
            While .Busy Or .readyState <> 4: DoEvents: Wend
            outputs(r) = .document.querySelector("#knowledge-currency__tgt-input").innerText
        Next
    End With
    'Depending on size of outputs you may need to loop to write out instead of transpose
    ws.Cells(2, 3).Resize(UBound(outputs), 1) = Application.Transpose(outputs)
End Sub

You'd need error handling though and consider what to do about potentially being blocked, losing internet connection, page load fails, incorrect inputs.....

Explore the actual web traffic for that page and see if you can mimic the request the page actually does. As with option 2 you will need to see what the terms and conditions have to say about doing this. This is also likely a more fragile method in the long run.

score 0 · Answer 3 · answered Jul 22 '19 at 06:38

This is a function I had made based on QHarr's answer:

Option Explicit

Function OnlineCurrency(current_country As String, to_country As String) As String
Dim ie As InternetExplorer
Dim url As String

Set ie = New InternetExplorer
With ie
    .Visible = False
    url = "http://www.google.com/search?q=" & current_country & "+to+" & to_country
    .Navigate2 url
    While .Busy Or .readyState <> 4: DoEvents: Wend
    OnlineCurrency = .document.querySelector(".dDoNo").innerText
    OnlineCurrency = Left(OnlineCurrency, InStr(OnlineCurrency, " ") - 1)
    .Quit
End With

End Function

But still there has some limitation:

1) When functions require to run many times excel may get crash (Due to high ram usage)

2) Sometimes the result will feedback VALUE# (this may due to the large query at the same time to Google pages)

3) If Google changes its class name due to the update the program itself will be useless.

VBA obtain online currency

3 Answers3