How to Handle Errors in VBA: resume the loop with the next value

[wellwell]

Dear all,

I am using a readily available piece of code that is supposed to use Google in order to search for a list of entries, returning the first result from each search.

Here is the code itself:

[/COLOR]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


[COLOR=#333333]

In some cases, Google would not be able to find results on my search. In that case the code above stops running. I get error in line 18:

[COLOR=#333333]Set link = objH3.getelementsbytagname("a")(0)[/COLOR]

I`m a big fan of STATA and really love the "capture" command there, which you can use in order to go to the next value in the loop (leaving a simple "Error" message) in case of an error without interrupting the code. There must be the same option here and I would be very grateful if you can give me any advice on this.

Thanks in advance!

 

[Kenneth Hobson]

You could probably use "On Error Resume Next" and then check the error number after setting the object.

Parts of this may help.

Sub TestErrorRoutine()
  Dim x As Integer, Msg As String
  On Error GoTo ErrMsg
  
  x = 1 / 0
  
  GoTo EndNow
ErrMsg:
    If Err.Number <> 0 Then
        Msg = "Error # " & Str(Err.Number) & " was generated by " _
                & Err.Source & Chr(13) & Err.Description
        MsgBox Msg, , "Error", Err.HelpFile, Err.HelpContext
        Exit Sub
    End If
EndNow:
End Sub

 

[wellwell]

Thank you very much for your reply!

I tried to overcome the issue with an "On Error Resume Next" statement earlier today but couldn't fix it properly. It seemed to run smoothly up to a point but then started giving me the same entries for apparently different search words.