VBA 数据从 Google 导入 Excel：自定义时间范围答案

【问题标题】：VBA Data Import from Google into Excel: Custom Time RangesVBA 数据从 Google 导入 Excel：自定义时间范围
【发布时间】：2018-11-18 19:04:37
【问题描述】：

对于 Excel 中的 VBA 应用程序，我试图在缩小搜索范围时包含 Google 提供的“自定义时间范围”功能。到目前为止，我正在使用以下代码（见下文），它允许将给定搜索词的“resultStats”从 Google 导入 Excel，但缺少时间范围选项。

在这种特定情况下，我需要确定结果/文章的数量，例如2015 年 1 月 1 日至 2015 年 12 月 31 日期间为“埃隆·马斯克”拍摄。下面的代码是否有任何可行的补充？这也可以应用于 Google 新闻标签而不是常规的 Google 搜索结果吗？

非常感谢！

Sub Gethits()
Dim url As String, lastRow As Long
Dim XMLHTTP As Object, html As Object, objResultDiv As Object, objH3 As Object, link As Object
Dim start_time As Date
Dim end_time As Date
Dim var As String
Dim var1 As Object

lastRow = Range("A" & Rows.Count).End(xlUp).Row

Dim cookie As String
Dim result_cookie As String

start_time = Time
Debug.Print "start_time:" & start_time

For i = 2 To lastRow

    url = "https://www.google.com/search?q=" & Cells(i, 1) & "&rnd=" & WorksheetFunction.RandBetween(1, 10000)

    Set XMLHTTP = CreateObject("MSXML2.serverXMLHTTP")
    XMLHTTP.Open "GET", url, False
    XMLHTTP.setRequestHeader "Content-Type", "text/xml"
    XMLHTTP.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1; rv:25.0) Gecko/20100101 Firefox/25.0"
    XMLHTTP.send

    Set html = CreateObject("htmlfile")
    html.body.innerHTML = XMLHTTP.responseText
    Set objResultDiv = html.getElementById("rso")
    Set var1 = html.getElementById("resultStats")
    Cells(i, 2).Value = var1.innerText

    DoEvents
Next

end_time = Time
Debug.Print "end_time:" & end_time

Debug.Print "done" & "Time taken : " & DateDiff("n", start_time, end_time)
MsgBox "done" & "Time taken : " & DateDiff("n", start_time, end_time)

结束子

【问题讨论】：

标签： html excel vba web-scraping

【解决方案1】：

您似乎需要 URL 编码，因此当您包含 cd_max 和 cd_min 参数时，如下所示的字符串有效。您使用参数tbm=nws 指定news。

正如@chillin 所说，您可以使用Application.Encodeurl() 实现参数编码。

我也尝试了 API 方法，但收效甚微。虽然 dataRange 过滤器可以在 sort 参数中传递，但您需要注册 API 密钥，设置自定义搜索引擎并设置您的要求。每个查询最多 10 个结果；免费调用有 API 调用限制。您可以指定一个起始编号以获取 10 个块。您还可以通过运行 Google APIs explorer - custom search 查看 URL 编码的内容。我发现它只返回了 2 个结果，显然不在预期数字的范围内。

Option Explicit

Public Sub GetResultCount()
    Dim sResponse As String, html As HTMLDocument
    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", "https://www.google.co.uk/search?q=elon+musk&safe=strict&biw=1163&bih=571&source=lnt&tbs=cdr%3A1%2Ccd_min%3A1%2F1%2F2015%2Ccd_max%3A12%2F31%2F2015&tbm=nws", False
        .setRequestHeader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT"
        .send
         sResponse = StrConv(.responseBody, vbUnicode)
    End With
    Set html = New HTMLDocument
    With html
        .body.innerHTML = sResponse
        Debug.Print .querySelector("#resultStats").innerText
    End With
End Sub

【讨论】：

可能值得一提的是，在现代 Excel 版本中，可以使用Application.Encodeurl() 实现 URL 编码。
@chillin 是的。谢谢。

【解决方案2】：

感谢您的反馈。我现在修改了 URL 行如下（包括 Excel ENCODEURL 函数，我直接将它应用于 Excel 电子表格的输入单元格）并且它运行良好：

url = "https://www.google.com/search?q=" & Cells(i, 1) & "&source=lnt&tbs=cdr%3A1%2Ccd_min%3A" & Cells(i, 2) & "%2Ccd_max%3A" & Cells(i, 3) & "&tbm=nws"

【讨论】：