CODEWITHSUNDEEP
excelvbaweb-scraping
Rajput
Rajput

Reputation: 605

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

I have been using below code and it is giving me an error that is Run Time Error '91' : Object Variable or With Block not Set I do not know why.

Earlier it was working fine but i do not know why an error is occur. I have tried other solutions searching Copy URL from the first Search but they also were not working.

error appear on this line Set link = ecoll.getElementsByTagName("a")(0)

If someone can provide alternate solution it will be great help. Any help will be appreciated.

enter image description here

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

Upvotes: 1

Views: 567

Answers (2)

AziMez
AziMez

Reputation: 2072

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.

enter image description here

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
                      j = 20 ' Once catching the 1st link, FOR loop is skipped
                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]

enter image description here

Upvotes: 1

QHarr
QHarr

Reputation: 84465

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)

Upvotes: 2

Related Questions