Автоматический поиск в Google

Question

У меня есть более 20 000 поисков, которые мне нужно сделать в Google. Я хочу использовать VBA для автоматического поиска в google или inte rnet explorer и вернуть ссылку в excel. Я пробовал несколько формул VBA, и ни одна из них, кажется, не работает. Есть ли формула, которая позволит автоматизировать поиск и вернуть ссылку на первый сайт в поиске Google, чтобы преуспеть? Ниже приведена формула, которую я сейчас использую, но она не работает. Я ищу адреса в столбце A и мне нужна ссылка для возврата в столбец B.

Sub XMLHTTP_Count()
    Dim url As String, lastRow As Long
    Dim XMLHTTP As Object, html As Object
    Dim start_time As Date
    Dim end_time As Date

    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.co.in/search?q=" & Cells(i, 1) & "&rnd=" & WorksheetFunction.RandBetween(1, 10000)

        Set XMLHTTP = CreateObject("MSXML2.XMLHTTP")
        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

    If html.getElementById("resultStats") Is Nothing Then
        str_text = "0 Results"
    Else
        str_text = html.getElementById("resultStats").innerText
    End If
        Cells(i, 2) = str_text
        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

Я думаю, что ответил на ваш первоначальный вопрос. Это звучит как новый вопрос, и, вероятно, это требует нового поста, но я * go впереди и предложу здесь второй ответ, чтобы ответить на этот вопрос.

Sub WebPage()

    Dim internet As Object
    Dim internetdata As Object
    Dim div_result As Object
    Dim header_links As Object
    Dim link As Object
    Dim URL As String

    Set internet = CreateObject("InternetExplorer.Application")
    internet.Visible = True

    URL = "https://www.google.co.in/search?q=how+to+program+in+vba"
    internet.Navigate URL

    Do Until internet.ReadyState >= 4
        DoEvents
    Loop

    Application.Wait Now + TimeSerial(0, 0, 5)

    Set internetdata = internet.Document
    Set div_result = internetdata.getelementbyid("res")


    Set header_links = div_result.getelementsbytagname("h3")

    For Each h In header_links
        Set link = h.ChildNodes.Item(0)
        Cells(Range("A" & Rows.Count).End(xlUp).Row + 1, 1) = link.href
    Next

    MsgBox "done"
End Sub

Результат:

Вы можете легко преобразовать каждое текстовое поле в гиперссылку, если хотите сделать все эти кликабельными ссылки. Не стесняйтесь изменять код в соответствии с вашими потребностями.

Answer 2

Ну, вам не нужен рандомизатор, и похоже, что 'resultStats' изменился на 'result-stats'. Попробуйте приведенный ниже код и убедитесь, что он делает то, что вам нужно.

Sub GetSearchStats()
    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)
        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("result-stats")
        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

Результат: