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
LoopIf you like, post an example file for us to test.