【问题标题】:Web Scraping with VBA (when HTML <> DOM)使用 VBA 进行网页抓取(当 HTML <> DOM 时)
【发布时间】:2017-08-20 14:16:14
【问题描述】:

我在抓取这个特定网页的数据时度过了一段可怕的时光......基本上,当我在浏览器中加载 URL 并手动点击 F12 时,我可以在“DOM Explorer”中看到我需要的信息,但是当我以编程方式尝试时为了做同样的事情(见下文),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 并不总是您在浏览器中看到的内容,而是创建您可以在浏览器中看到的内容的说明,但是必须有一种方法可以通过 HTML 以编程方式创建 DOM...

另外,我相信我所追求的数据是由脚本或 iFrames 生成的,但是我一直无法生成我正在寻找的数据。

更新

参见下面的 DOM Explorer 图片:

【问题讨论】:

  • 请更具体并发布预期的输出,可能是网页的屏幕截图,其中突出显示了该数据所在的区域,以及您正在抓取的 URL。 This question 可能会有所帮助。
  • 嗨@omegastripes - 我尝试将屏幕截图放入但无法将它们粘贴到编辑窗口中......如果您需要任何有关这方面的信息,请告诉我,我可以发送给您 - 我我确定我有它...另外,我现在正在查看其他示例,到目前为止还没有运气..
  • 来自Editing Help - images 也可以按CTRL+I插入图片。
  • @TheSilkCode 然后发布预期的输出。
  • 嗨@omegastripes - 我添加了一张包含我想要的信息的 DOM 资源管理器的图片 - 但是,不确定显示 HTMLDoc 内容的最佳方式是什么......让我知道

标签: json vba excel web-scraping xmlhttprequest


【解决方案1】:

大纲:

实际上,每次打开该网页时,网络浏览器都会执行几乎相同的操作。

您可以使用下面的 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 响应中提取所需的数据。

【讨论】:

  • 这太棒了——那里有很多东西,所以我还没有通过所有的测试,但我相信这会让我走上正轨,非常感谢!
  • 终于通过了所有这些的测试——效果很好,所以谢谢你的帮助,但我确实改变了一些东西——1)修剪 API URL 只请求我感兴趣的数据以及改变单位为英语和 2) 而不是使用您的 JSON 解析器解决方案我实际上使用了一系列拆分和循环来解析数据 - 这样做的一个原因是因为我很难遵循 JSON 解析代码而且我没有喜欢使用我不懂的复制和粘贴代码,但我也发现它比使用 Rage 和 Scripting Dictionaries 解析快 60%。无论如何,再次感谢!
猜你喜欢
  • 2019-03-15
  • 2019-04-03
  • 2017-11-04
  • 2019-12-23
  • 2016-09-12
  • 1970-01-01
  • 2020-11-30
  • 1970-01-01
相关资源
最近更新 更多