Импорт данных VBA из Google в Excel: пользовательские диапазоны времени

Question

Для приложения VBA в Excel я пытаюсь включить функцию «настраиваемого временного диапазона», которую Google предлагает при сужении поиска. До сих пор я использую следующий код (см. Ниже), который позволяет импортировать «resultStats» из Google для заданного поискового запроса в Excel, но не имеет опции временного диапазона.

В этом конкретном случае мне нужно будет определить количество результатов / статей, например, для "Элон Маск" с 01.01.2015 по 31.12.2015. Есть ли практическое дополнение к приведенному ниже коду? И может ли это также применяться для вкладки Новости 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)

End Sub

Answer 1

Спасибо за ваш отзыв. Теперь я изменил строку 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"

Answer 2

Кажется, вам нужно кодирование URL, поэтому строка, показанная ниже, работает, когда вы включаете параметры cd_max и cd_min. Вы указываете news с параметром tbm=nws.

Как упоминает @chillin, вы можете добиться кодирования параметров с помощью Application.Encodeurl().

Я также попробовал метод API, но с ограниченным успехом. Хотя фильтр dataRange можно передать в параметре sort, вам необходимо зарегистрироваться для получения ключа API, настроить пользовательскую поисковую систему и задать свои требования. Результаты не более 10 на запрос; Для бесплатных звонков существует ограничение на количество вызовов API. Вы можете указать начальный номер, чтобы получить блоки по 10. Вы также можете увидеть, что URL закодирован, запустив через проводник Google API * 1010 - пользовательский поиск . Я обнаружил, что он дал только 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