如何处理 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 响应 here。

下载json解析器here

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

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