Как работать с классом hasDatepicker - IE Automation

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