Object variable or with block variable set

[thewiseguy]

Hello everyone.

I have been running the infamous "google search" vba and just cant get it work properly. It will run and then stop after approx 80 records and give me this error:

"Object variable or with block variable set"

From time to time, I have to wait an hour or so before the macro will allow itself to run. Here is the code.....is anything glaring?

(thank you in advance for looking)

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
Dim rngCt As Long
Dim cookie As String
Dim result_cookie As String
lastRow = Range("A" & Rows.Count).End(xlUp).Row
start_time = Time
Debug.Print "start_time:" & start_time
Set XMLHTTP = CreateObject("MSXML2.serverXMLHTTP")
Set html = CreateObject("htmlfile")
For rngCt = 2 To lastRow
    
    url = "https://www.google.co.in/search?q=" & Cells(rngCt, 1) & "&rnd=" & WorksheetFunction.RandBetween(1, 10000)
    
    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
    DoEvents
    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(Replace(link.innerHTML, "", ""), "", "")
    
    Cells(rngCt, 2) = str_text
    Cells(rngCt, 3) = link.href
    DoEvents
    Set objResultDiv = Nothing
    Set objH3 = Nothing
    Set link = Nothing
    DoEvents
Next rngCt
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

[Kenneth Hobs]

Welcome to the forum!

When writing to the file, some speedup tips might help at some point. http://vbaexpress.com/kb/getarticle.php?kb_id=1035

You might want to include a readystate loop or two.

' http://www.vbaexpress.com/forum/showthread.php?t=42251Sub test()
  Dim xDOC As DOMDocument
  Dim XMLHttpRequest As XMLHTTP
  Dim response As String
  Dim URL As String
  Dim sTemperature As String
  
  URL = "http://rss.weatherzone.com.au/?u=12994-1285&lt=aploc&lc=5594&obs=1&fc=1&warn=1"
  
  Set XMLHttpRequest = New MSXML2.XMLHTTP
  With XMLHttpRequest
    .Open "GET", URL, False
    Do Until .readyState = 1
    Loop
    .send
  End With
  
  Set xDOC = New DOMDocument
  
  Do Until xDOC.readyState = 4
  Loop
  xDOC.LoadXML (XMLHttpRequest.responseText)
  
  sTemperature = DisplayNode(xDOC.ChildNodes)
  
  On Error Resume Next
  
  MsgBox "Melb. " & sTemperature & " °C"
End Sub


Public Function DisplayNode(ByRef Nodes As IXMLDOMNodeList)
  Dim xNode As IXMLDOMNode
  Dim Start As String
  Dim Finish As String
  Dim Output As String
  
  For Each xNode In Nodes
    If xNode.NodeType = NODE_CDATA_SECTION And _
      InStr(xNode.NodeValue, "Temperature:") <> 0 Then
      Start = InStr(xNode.NodeValue, "Temperature:") + 17
      Finish = InStr(xNode.NodeValue, Chr(35)) - 1
      DisplayNode = Mid(xNode.NodeValue, Start, Finish - Start)
    End If
    If DisplayNode <> "" Then Exit Function
    If xNode.HasChildNodes Then
      Output = DisplayNode(xNode.ChildNodes)
      If Output <> "" Then DisplayNode = Output
    End If
  Next xNode
End Function

[thewiseguy]

Kenneth - thanks for taking the time to look at this. I am a novice, so my question is - where does this go with respect to my original code? Are you able to combine my original code and yours to show me what it would it look like?

[Kenneth Hobs]

See my kb article for where to put those speedup routines. Not that it will help or the loop. They are good things to do though.

Replace your DoEvents with:

Do Until XMLHTTP.readyState = 1
Loop

If you like, post an example file for us to test.