问题
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