Получить веб-страницу, включая контент AJAX

Я уже давно использую VBA для получения цен акций с сайта ASX (www.asx.com.au), однако мой сценарий больше не работает, поскольку веб-сайт был обновлен и теперь использует javascripts для создания контента.

В результате скрипт, показанный ниже, теперь возвращает разделы, а не содержимое страницы.

VBA (довольно стандартный стандарт):

With CreateObject("WINHTTP.WinHTTPRequest.5.1")
    .Open "GET", strURL, False
    .send
    http.body.innerHTML = .responseText
End With

И.responseText содержит такие вещи, как:

<SCRIPT>
    var urlArray = window.location.hash.split('/');
    if (urlArray != null) {
      var var1 = urlArray[1];
      window.location = "http://www.asx.com.au/asx/research/companyInfo.do?by=asxCode&asxCode=" + var1;
    }
</SCRIPT>

Как я могу получить веб-страницу так, как ее можно просматривать в браузере? Единственное, что я не пробовал, - это создание объекта браузера, который может извлечь HTML из этого.

Источник

1 ответ

Решение

На веб-сайте http://www.asx.com.au/ доступен API. Я открыл страницу в Chrome для одной из компаний - AMC по ссылке http://www.asx.com.au/asx/share-price-research/company/AMC, затем открыл окно Инструменты разработчика (F12), Сеть и изучил XHR в списке после загрузки страницы после того, как я щелкнул каждый раздел. Я нашел несколько URL, которые возвращают данные в формате JSON:

Чтобы увидеть структуру представленных данных, содержимое ответа можно скопировать и вставить в любое средство просмотра JSON (например, этот онлайн-инструмент http://jsonviewer.stack.hu/).

Вы можете использовать приведенный ниже код VBA для анализа ответа с URL-адреса https://www.asx.com.au/asx/1/share/AMC/prices и вывода результата. Импортируйте модуль JSON.bas в проект VBA для обработки JSON.

Option Explicit

Sub Test_query_ASX()

    Const Transposed = False ' Output option

    Dim sCode As String
    Dim sInterval As String
    Dim sCount As String
    Dim sJSONString As String
    Dim vJSON As Variant
    Dim sState As String
    Dim aRows()
    Dim aHeader()

    sCode = "AMC"
    sInterval = "daily"
    sCount = "10"

    ' Get JSON via API
    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", "https://www.asx.com.au/asx/1/share/" & sCode & "/prices?interval=" & sInterval & "&count=" & sCount, False
        .Send
        sJSONString = .ResponseText
    End With
    ' Parse JSON response
    JSON.Parse sJSONString, vJSON, sState
    If sState = "Error" Then
        MsgBox "Invalid JSON"
        Exit Sub
    End If
    ' Pick core data
    vJSON = vJSON("data")
    ' Convert each data set to array
    JSON.ToArray vJSON, aRows, aHeader
    ' Output array to worksheet
    With ThisWorkbook.Sheets(1)
        .Cells.Delete
        If Transposed Then
            Output2DArray .Cells(1, 1), WorksheetFunction.Transpose(aHeader)
            Output2DArray .Cells(1, 2), WorksheetFunction.Transpose(aRows)
        Else
            OutputArray .Cells(1, 1), aHeader
            Output2DArray .Cells(2, 1), aRows
        End If
        .Columns.AutoFit
    End With
    MsgBox "Completed"

End Sub

Sub OutputArray(oDstRng As Range, aCells As Variant)

    With oDstRng
        .Parent.Select
        With .Resize(1, UBound(aCells) - LBound(aCells) + 1)
            .NumberFormat = "@"
            .Value = aCells
        End With
    End With

End Sub

Sub Output2DArray(oDstRng As Range, aCells As Variant)

    With oDstRng
        .Parent.Select
        With .Resize( _
                UBound(aCells, 1) - LBound(aCells, 1) + 1, _
                UBound(aCells, 2) - LBound(aCells, 2) + 1)
            .NumberFormat = "@"
            .Value = aCells
        End With
    End With

End Sub

Бежать Sub Test_query_ASX() обрабатывать данные. Вывод на Sheet1 для меня выглядит следующим образом:

выход

Имея этот пример, вы можете извлечь нужные данные из ответов JSON по указанным URL-адресам. Кстати, тот же подход используется в этом и в этом ответах.

ОБНОВИТЬ

После некоторых изменений на сайте необходимо использовать https://www.asx.com.au/asx/... вместо http://www.asx.com.au/b2c-api/..., поэтому я исправил все вышеупомянутые URL.

Источник
Другие вопросы по тегам