How to handle with hasDatepicker class - IE Automation - excel

Question

I have such peas of code that open web page with two input boxes. I am trying to display a currency table with a different date than the default, but it does not work. Everything is fine only while mouse clicking on "Report" button - then I can display any date.
Does anyone have any idea?
I have already tried with: "Application.SendKeys ("{ENTER}"), True" and with different date format. I was also looking for information about hasDatepicker class...
Sub getDataFrombrowser()
Dim address As String
Dim browser As InternetExplorer
Set browser = New InternetExplorerMedium
With browser
.Visible = True
End With
address = "http://www.nbrm.mk/kursna_lista-en.nspx"
With browser
.navigate address
Do While .Busy Or .readyState <> 4: DoEvents: Loop
.navigate address
Do While .Busy Or .readyState <> 4: DoEvents: Loop
End With
browser.document.getElementsByClassName("form-control sdate hasDatepicker")(0).Value = Format(Date - 1, "DD.MM.YYYY")
browser.document.getElementsByClassName("form-control edate hasDatepicker")(0).Value = Format(Date - 1, "DD.MM.YYYY")
Set objCollection = browser.document.getElementsByTagName("input")
objCollection(7).Click
End Sub

Answer 1

You can mimic the POST request the page does and use XMLHTTP rather than a slow browser. You get a json response. You can use a json parser to handle this and extract what info you want. I extract everything. Headers are in Slovenian but you could substitute with your own hardcoded English values. View full example json response here.
Download json parser here
You specify the start and end dates in the body of the request.
Public Sub GetRates()
'install https://github.com/VBA-tools/VBA-JSON/blob/master/JsonConverter.bas and add to project
'VBE > Tools > References > Microsoft Scripting Runtime Library
Dim json As Object, body As String
Dim ws As Worksheet, results(), headers()
body = "{""startDate"":""23.03.2019"",""endDate"":""21.04.2019"",""isStateAuth"":""0""}"
Set ws = ThisWorkbook.Worksheets("Sheet1")
With CreateObject("MSXML2.XMLHTTP")
.Open "POST", "http://www.nbrm.mk/services/ExchangeRates.asmx/GetEXRates", False
.setRequestHeader "User-Agent", "Mozilla/5.0"
.setRequestHeader "Content-Type", "application/json; charset=UTF-8"
.setRequestHeader "Referer", "http://www.nbrm.mk/kursna_lista-en.nspx"
.setRequestHeader "Content-Length", Len(body)
.send body
Set json = JsonConverter.ParseJson(.responseText)
Dim ratesParent As Object, rates As Object, rate As Object, header As Object
Set ratesParent = json("d")
Set header = ratesParent.item(1)("ExchangeRates").item(1)
ReDim results(1 To 10000, 1 To header.Count)
ReDim headers(1 To header.Count)
Dim key As Variant, c As Long, r As Long
headers = header.keys
For Each rates In ratesParent
For Each rate In rates("ExchangeRates") 'dictionaries
r = r + 1: c = 1
For Each key In rate.keys
results(r, c) = rate(key)
c = c + 1
Next
Next
Next
With ws
.Cells(1, 1).Resize(1, UBound(headers) + 1) = headers
.Cells(2, 1).Resize(UBound(results, 1), UBound(results, 2)) = results
End With
End With
End Sub