如何处理hasDatepicker类 - IE自动化

Question

我有这样的代码，可以打开带有两个输入框的网页。我正在尝试显示与默认值日期不同的货币表，但它不起作用。只有鼠标单击"报告"按钮时，一切都很好 - 然后我可以显示任何日期。 有人知道吗？

我已经尝试过："Application.SendKeys ("{ENTER}")， True"和不同的日期格式。我也在寻找有关hasDatepicker类的信息...

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

您可以模仿页面执行的 POST 请求并使用 XMLHTTP 而不是慢速浏览器。您会收到一个 json 响应。您可以使用 json 解析器来处理此问题并提取所需的信息。我提取一切。标题是斯洛文尼亚语，但你可以用你自己的硬编码英语值替换。在此处查看完整的示例 json 响应。

在此处下载 json 解析器

您可以在请求正文中指定开始日期和结束日期。

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