Error on getting the URL result of a Google search

Question

I am new to VBA, and I figured that trying to code is the best way to code. Anyway, I am trying to code a macro that will get first URL of a Google search result, but I'm getting error Object variable or With block variable not set when search result is 0, and the remaining operations are skipped. Here's the error image:

Here is the code I used:

Sub XMLHTTP()

   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

   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.co.in/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 objH3 = objResultDiv.getElementsByTagName("H3")(0)
      Set link = objH3.getElementsByTagName("a")(0)


      str_text = Replace(link.innerHTML, "<EM>", "")
      str_text = Replace(str_text, "</EM>", "")

      Cells(i, 2) = str_text
      Cells(i, 3) = link.href
      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

Can anyone help me please?

Answer 1

One simple workaround--though not the best--is to skip the error.

Try the following modification:

start_time = Time
Debug.Print "start_time:" & start_time

On Error Resume Next '--Add this part.
For i = 2 To lastRow

Other options include a true error handling part, something that returns a value when your search returns nothing.

Let us know if this helps.

Answer 2

In the zero result case, H3 is empty so modify your code like this to handle this case

  Set html = CreateObject("htmlfile")
  html.body.innerhtml = XMLHTTP.ResponseText
  Set objResultDiv = html.getelementbyid("rso")

  **numb_H3 = objResultDiv.getElementsByTagName("H3").Length**
  **If numb_H3 > 0 Then**
      Set objH3 = objResultDiv.getElementsByTagName("H3")(0)
      Set link = objH3.getElementsByTagName("a")(0)

      str_text = Replace(link.innerhtml, "<EM>", "")
      str_text = Replace(str_text, "</EM>", "")

      Cells(i, 2) = str_text
      Cells(i, 3) = link.href
  **Else**
  **End If**
  DoEvents

Next

Answer 3

Here is simplified code for the same method.

Sub xmlHttp()
    Dim url As String,
        lastRow As Long,
        XMLHTTP As Object, 
        html As Object,
        objResultDiv As Object,
        objH3 As Object,
        link As Object

    lastRow = Range("A" & Rows.Count).End(xlUp).Row
    For i = 2 To lastRow
        url = "https://www.google.co.in/search?q=" & Cells(i, 1)
        Set xmlHttp = CreateObject("MSXML2.XMLHTTP")
        xmlHttp.Open "GET", URL, False
        xmlHttp.setRequestHeader "Content-Type", "text/xml"
        xmlHttp.send
        Set html = CreateObject("htmlfile")
        html.body.innerHTML = xmlHttp.ResponseText
        Set objResultDiv = html.getelementbyid("rso")
        numb_H3 = objResultDiv.getElementsByTagName("H3").Length
        If numb_H3 > 0 Then
            Set objH3 = objResultDiv.getElementsByTagName("H3")(0)
            Set link = objH3.getElementsByTagName("a")(0)
            Range(i, 2) = link
        Else
        End If
        DoEvents
    Next
End Sub