0

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
Pete T
  • 31
  • 1
  • 5
  • 2
    Possible duplicate of [How to get the first search result link of a google search using VBA?](https://stackoverflow.com/questions/53100287/how-to-get-the-first-search-result-link-of-a-google-search-using-vba) – TinMan Aug 08 '19 at 10:01
  • Pete, in order to answer someone who has communicated with you in comments it's necessary to "ping" them using the @, for example: @Pᴇʜ - otherwise there will be notification :-) – Cindy Meister Aug 08 '19 at 13:16
  • @PeteT Did you check out the accepted answer in the link that TinMan posted in his comment? It does exactly what you want. – Pᴇʜ Aug 08 '19 at 13:20
  • @PeteT I Adapted the code suggested by TinMan to fit it to your needs, please give [this](https://stackoverflow.com/a/57414281/11167163) a try – TourEiffel Aug 08 '19 at 13:55

2 Answers2

0

This code will do the job,

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

Tools --> References --> Microsoft Internet Controls

In Picture :

enter image description here

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
TourEiffel
  • 4,034
  • 2
  • 16
  • 45
0

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