Run Time Error '91' : Object Variable or With Block not Set-CodePudding

The

Sub link() Dim doc As HTMLDocument Set doc = New HTMLDocument Dim lastrow As Long Dim ecoll As Object Dim link As Object Dim t As Date lastrow = Range("A" & Rows.Count).End(xlUp).Row t = Now() Dim reqObj As Object Set reqObj = CreateObject("MSXML2.XMLHTTP") For i = 2 To lastrow reqObj.Open "GET", "https://www.google.co.in/search?q=" & Cells(i, 1) & "&rnd=" & WorksheetFunction.RandBetween(1, 10000), False reqObj.send doc.body.innerHTML = reqObj.responseText Set ecoll = doc.getElementById("rso") Set link = ecoll.getElementsByTagName("a")(0) Cells(i, 2) = link.href Next Set doc = Nothing Set reqObj = Nothing Debug.Print "done" & "Time taken : " & Format(Now() - t, "hh:mm:ss") MsgBox "Ellapsed Time - " & Format(Now() - t, "hh:mm:ss") End Sub

CodePudding user response：

There is cookie consent required, or else you get don't get the expected search results; and the html, at least for me, is different. It was sufficient for me to add the following headers:

reqObj.setRequestHeader "cookie", "CONSENT=YES " reqObj.setRequestHeader "User-Agent", "Mozilla/5.0"

Then I needed a different ID of:

Set ecoll = doc.getElementById("main")

Your mileage may vary.

Then you need to target the a tags with more discrimination, or you will get a lot of stuff you almost certainly don't want.

So, try removing:

Set link = ecoll.getElementsByTagName("a")(0)

And then use this:

Cells(i, 2) = Replace$(ecoll.querySelector("[href*=url]").href, "about:/url?q=", vbNullString)

CodePudding user response：

Hope this help you

Firstly, It's appear that the html contenent in reqObj.responseText does not contain any element with id "rso" at all.

Further more, the response coming to vba from "https://www.google.co.in/search?q=" is not the same that presented in browser.

So, I try to do some tricks to catch the first search result showed on google.

For example, with the keyword "BakPhysio" we get this one.

At this point we can get the link Description in the using

.getElementsByTagName("H3")(0).innerText

In the other hand, URL link is located near href section, we catch it using substring between "url?q=" and "&"

This following VBA code should give you some results.

Sub link() Dim doc As HTMLDocument Set doc = New HTMLDocument Dim lastrow As Long Dim ecoll As Object Dim Link As Object Dim t As Date lastrow = Range("A" & Rows.Count).End(xlUp).Row t = Now() Dim reqObj As Object Set reqObj = CreateObject("MSXML2.XMLHTTP") For i = 2 To lastrow reqObj.Open "GET", "https://www.google.co.in/search?q=" & _ Cells(i, 1) & "&rnd=" & WorksheetFunction.RandBetween(1, 10000), False reqObj.send doc.body.innerHTML = reqObj.responseText Set all_link = doc.getElementsByTagName("A") Dim html, description, Url As String Dim start_position, end_position As Integer For j = 1 To 20 'all_link.Length - 1 html = all_link(j).outerHTML If InStr(LCase(html), LCase("/url?q=")) Then start_position = InStr(html, "http") end_position = InStr(html, "&") Url = Mid(html, start_position, end_position - start_position) If InStr(LCase(html), LCase("<h3")) Then description = all_link(j).getElementsByTagName("h3")(0).innerText MsgBox description & vbNewLine & Url Cells(i, 2) = Url End If End If Next j Next i Set doc = Nothing Set reqObj = Nothing Debug.Print "done" & "Time taken : " & Format(Now() - t, "hh:mm:ss") MsgBox "Ellapsed Time - " & Format(Now() - t, "hh:mm:ss") End Sub

[Result]