Web Scraping с VBA (когда HTML <> DOM)

Question

Я ужасно тратил время на очистку данных этой веб-страницы... В основном я вижу нужную информацию в "DOM Explorer", когда загружаю URL-адрес в браузере и нажимаю F12 вручную, но когда я программно пытаюсь выполнить то же самое (см. ниже) HTMLDoc не содержит ту же информацию, которую я вижу в "DOM Explorer"...

Public Sub testCode()

    Dim IE As SHDocVw.InternetExplorer
    Dim HTMLDoc As MSHTML.HTMLDocument
    Set IE = New SHDocVw.InternetExplorer
    With IE
        .navigate "https://www.wunderground.com/cgi-bin/findweather/getForecast?query=EIDW"
        While .Busy = True Or .ReadyState <> READYSTATE_COMPLETE: Wend
        Set HTMLDoc = .Document
    End With

End Sub

Может кто-нибудь помочь мне получить доступ к информации в "DOM Explorer"? Я знаю, что HTML - это не всегда то, что вы видите в браузере, а скорее инструкции для создания того, что вы видите в браузере, но тогда должен быть способ программно создать DOM из HTML...

Кроме того, я считаю, что данные, которые мне нужны, генерируются скриптами или iFrames, но я не смог сгенерировать искомые данные из-за того, что возился с любым из них....

ОБНОВИТЬ

Смотрите изображение DOM Explorer ниже:

Answer 1

Контур:

• Сделайте GET XHR для https://www.wunderground.com/cgi-bin/findweather/getForecast?query=EIDW.

• Извлечь местоположение из строки ответа HTML var query = 'zmw:' + '00000.271.03969'; и ключ от линий var citypage_options = {k: 'c991975b7f4186c0', ...,

• Сделайте GET XHR, используя местоположение 00000.271.03969 и ключ c991975b7f4186c0 на https://api-ak-aws.wunderground.com/api/c991975b7f4186c0/forecast10day/hourly10day/labels/conditions/astronomy10day/lang:RU/units:metric/v:2.0/bestfct:1/q/zmw:00000.271.03969.json.

• Анализировать JSON-ответ (например, с помощью VBA JSON-анализатора), используя Parse(), конвертировать необходимые данные, используя ToArray()и выводить в виде таблиц на лист (ы).

На самом деле веб-браузер делает почти одинаковые вещи каждый раз, когда вы открываете эту веб-страницу.

Вы можете использовать приведенный ниже код VBA для анализа ответа и вывода результата. Импортируйте модуль JSON.bas в проект VBA для обработки JSON.

Sub TestScrapeWunderground()

    Dim sContent As String
    Dim sKey As String
    Dim sLocation As String
    Dim vJSON As Variant
    Dim sState As String
    Dim oDays As Object
    Dim oHours As Object
    Dim vDay As Variant
    Dim vHour As Variant
    Dim aRows() As Variant
    Dim aHeader() As Variant

    ' GET XHR to retrieve location and key
    With CreateObject("MSXML2.ServerXMLHTTP")
        .Open "GET", "https://www.wunderground.com/cgi-bin/findweather/getForecast?query=EIDW", False
        .Send
        sContent = .responseText
    End With
    ' Extract location and key from HTML content
    sLocation = Split(Split(sContent, "var query = 'zmw:' + '", 2)(1), "'", 2)(0)
    sKey = Split(Split(sContent, vbTab & "k: '", 2)(1), "'", 2)(0)
    ' GET XHR to retrieve JSON data
    With CreateObject("MSXML2.ServerXMLHTTP")
        .Open "GET", "https://api-ak-aws.wunderground.com/api/" & sKey & "/forecast10day/hourly10day/labels/conditions/astronomy10day/lang:en/units:metric/v:2.0/bestfct:1/q/zmw:" & sLocation & ".json", False
        .Send
        sContent = .responseText
    End With
    ' Parse JSON response to data structure
    JSON.Parse sContent, vJSON, sState
    ' Populate dictionaries with daily and hourly forecast data
    Set oDays = CreateObject("Scripting.Dictionary")
    Set oHours = CreateObject("Scripting.Dictionary")
    For Each vDay In vJSON("forecast")("days")
        oDays(vDay("summary")) = ""
        For Each vHour In vDay("hours")
            oHours(vHour) = ""
        Next
    Next
    ' Convert daily forecast data to arrays
    JSON.ToArray oDays.Keys(), aRows, aHeader
    ' Output daily forecast data to table
    With Sheets(1)
        .Cells.Delete
        OutputArray .Cells(1, 1), aHeader
        Output2DArray .Cells(2, 1), aRows
        .Columns.AutoFit
    End With
    ' Convert hourly forecast data to arrays
    JSON.ToArray oHours.Keys(), aRows, aHeader
    ' Output hourly forecast data to table
    With Sheets(2)
        .Cells.Delete
        OutputArray .Cells(1, 1), aHeader
        Output2DArray .Cells(2, 1), aRows
        .Columns.AutoFit
    End With
    ' Convert response data to arrays
    JSON.ToArray Array(vJSON("response")), aRows, aHeader
    ' Output response transposed data to table
    With Sheets(3)
        .Cells.Delete
        Output2DArray .Cells(1, 1), WorksheetFunction.Transpose(aHeader)
        Output2DArray .Cells(1, 2), WorksheetFunction.Transpose(aRows)
        .Columns.AutoFit
    End With
    ' Convert current data to arrays
    JSON.ToArray Array(vJSON("current_observation")), aRows, aHeader
    ' Output current transposed data to table
    With Sheets(4)
        .Cells.Delete
        Output2DArray .Cells(1, 1), WorksheetFunction.Transpose(aHeader)
        Output2DArray .Cells(1, 2), WorksheetFunction.Transpose(aRows)
        .Columns.AutoFit
    End With
    ' Populate dictionary with daily astronomy data
    Set oDays = CreateObject("Scripting.Dictionary")
    For Each vDay In vJSON("astronomy")("days")
        oDays(vDay) = ""
    Next
    ' Convert daily astronomy data to arrays
    JSON.ToArray oDays.Keys(), aRows, aHeader
    ' Output daily astronomy transposed data to table
    With Sheets(5)
        .Cells.Delete
        Output2DArray .Cells(1, 1), WorksheetFunction.Transpose(aHeader)
        Output2DArray .Cells(1, 2), WorksheetFunction.Transpose(aRows)
        .Columns.AutoFit
    End With
    ' Convert hourly history data to arrays
    JSON.ToArray vJSON("history")("days")(0)("hours"), aRows, aHeader
    ' Output hourly history data to table
    With Sheets(6)
        .Cells.Delete
        OutputArray .Cells(1, 1), aHeader
        Output2DArray .Cells(2, 1), aRows
        .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

Второй XHR возвращает данные JSON, чтобы понять, как из него извлекаются необходимые данные, вы можете сохранить JSON в файл, скопировать содержимое и вставить его в любое средство просмотра JSON для дальнейшего изучения. Я использую онлайн-инструмент http://jsonviewer.stack.hu/, структура корневого элемента показана ниже:

Есть 6 основных разделов, соответствующая часть данных извлекается и выводится на 6 рабочих листов (которые должны быть созданы вручную перед запуском):

Sheet1 - Daily forecast
Sheet2 - Horly forecast
Sheet3 - Response data (transposed)
Sheet4 - Current data (transposed)
Sheet5 - Astronomy (transposed)
Sheet6 - Hourly history data

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