thewiseguy
02-01-2015, 08:10 AM
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
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