How to extract first Google search result URL?

问题

I have a large list of search queries in column A. Is there any code I can use in order to extract the first Google search result URL in column B?

I have used the code below successfully but instead of extracting the first search result URL it gets the number of search results. Anyone can help me change the code as per my requirements?

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

回答1:

This code will do the job,

Please Note that you will need to add référence :

Tools --> References --> Microsoft Internet Controls

In Picture :

Option Explicit
Sub tryme()

Dim ie As New InternetExplorer
Dim lastrow As Integer
Dim i As Integer

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


    For i = 2 To lastrow
        ie.Visible = False
        ie.navigate "https://www.google.com/search?q=" & Cells(i, 1)
        While ie.Busy Or ie.readyState < 4: DoEvents: Wend

       Cells(i, 2).Value = ie.document.querySelector("#search div.r [href*=http]").href

Next

End Sub

回答2:

In my case, I have used the following code

Sub Demo0()
Application.ScreenUpdating = False
    With CreateObject("InternetExplorer.Application")
        .Visible = True
    For R = 5 To Sheet1.Cells(Rows.Count, 2).End(xlUp).Row
        .Navigate "https://www.google.co.in/search?q=" & Sheet1.Cells(R, 2).Text
        While .Busy Or .ReadyState < 4:  DoEvents:  Wend
         With .Document.querySelectorAll("#search div.r [href*=http]")
                c = 3
             For U = 0 To Application.Min(8, .Length - 1) Step 2
                Sheet1.Cells(R, c) = .Item(U).href
                c = c + 1
             Next
         End With
    Next
        .Quit
    End With
Application.ScreenUpdating = True
End Sub

来源：https://stackoverflow.com/questions/57409710/how-to-extract-first-google-search-result-url

标签

excel

vba

google-search