0

I have a large excel file with a lot of strings in Column A. I would like the exact number of Google search results in Column B (and especially the option of showing 0 results - in fact, only knowing if there either exist or not exist results would be sufficient).

I'm aware that a VBA code for this exist here taken from this website.

But I'm having the same problems as these people commenting:

i got it to work in a test a few times, but now it says run-time error '2147024891 (80070005)'

then when i debug it, it highlights search_http.send

what is wrong?

I'm not an advanced Excel user, nor a VBA programmer so some guidance would be appreciated. Maybe I'm overlooking something basic that produces this error...

Many thanks,

Mauritz

Code I'm using:

    Public Sub ExcelGoogleSearch()Dim searchWords As String

    With Sheets("Sheet1")
    RowCount = 1
    Do While .Range("A" & RowCount) <> ""
    searchWords = .Range("A" & RowCount).Value

    ' Get keywords and validate by adding + for spaces between
    searchWords = Replace$(searchWords, " ", "+")

    ' Obtain the source code for the Google-searchterm webpage
    search_url = "http://www.google.com/search?hl=en&q=""" & searchWords & """&meta="""
    Set search_http = CreateObject("MSXML2.XMLHTTP")
    search_http.Open "GET", search_url, False
    search_http.send
    results_var = search_http.responsetext
    Set search_http = Nothing

    ' Find the number of results and post to sheet
    pos_1 = InStr(1, results_var, "resultStats>", vbTextCompare)

    If pos_1 = 0 Then
      NumberofResults = 0
    Else
      pos_2 = InStr(3 + pos_1, results_var, ">", vbTextCompare)
      pos_3 = InStr(pos_2, results_var, "<nobr>", vbTextCompare)
      NumberofResults = Mid(results_var, 1 + pos_2, (-1 + pos_3 - pos_2))
    End If

    Range("B" & RowCount) = NumberofResults
    RowCount = RowCount + 1
    Loop
    End With
    End Sub
Community
  • 1
  • 1
Mauritz
  • 117
  • 12

1 Answers1

1

My understanding is that xmlhttp has a limit on how many connections in a period of time. Just change to a different xmlhttp object when you error, you have 5 to choose from.

The URL has to be 100% correct. Unlike a browser there is no code to fix urls.

The purpose of my program is to get error details.

How I get a correct URL is to type my url in a browser, navigate, and the correct URL is often in the address bar. The other way is to use Properties of a link etc to get the URL.

Also Microsoft.XMLHTTP maps to Microsoft.XMLHTTP.1.0. HKEY_CLASSES_ROOT\Msxml2.XMLHTTP maps to Msxml2.XMLHTTP.3.0. Try a later one

Try this way using xmlhttp. Edit the url's etc. If it seems to work comment out the if / end if to dump info even if seeming to work. It's vbscript but vbscript works in vb6. 

 On Error Resume Next
 Set File = WScript.CreateObject("Microsoft.XMLHTTP")
 File.Open "GET", "http://www.microsoft.com/en-au/default.aspx", False
 'This is IE 8 headers
 File.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 8.0; Windows NT 6.0; Trident/4.0; SLCC1; .NET CLR 2.0.50727; Media Center PC 5.0; .NET CLR 1.1.4322; .NET CLR 3.5.30729; .NET CLR 3.0.30618; .NET4.0C; .NET4.0E; BCD2000; BCD2000)"
 File.Send
 If err.number <> 0 then 
    line =""
    Line  = Line &  vbcrlf & "" 
    Line  = Line &  vbcrlf & "Error getting file" 
    Line  = Line &  vbcrlf & "==================" 
    Line  = Line &  vbcrlf & "" 
    Line  = Line &  vbcrlf & "Error " & err.number & "(0x" & hex(err.number) & ") " & err.description 
    Line  = Line &  vbcrlf & "Source " & err.source 
    Line  = Line &  vbcrlf & "" 
    Line  = Line &  vbcrlf & "HTTP Error " & File.Status & " " & File.StatusText
    Line  = Line &  vbcrlf &  File.getAllResponseHeaders
    wscript.echo Line
    Err.clear
    wscript.quit
 End If

On Error Goto 0

 Set BS = CreateObject("ADODB.Stream")
 BS.type = 1
 BS.open
 BS.Write File.ResponseBody
 BS.SaveToFile "c:\users\test.txt", 2

Also see if these other objects work.

C:\Users>reg query hkcr /f xmlhttp

HKEY_CLASSES_ROOT\Microsoft.XMLHTTP
HKEY_CLASSES_ROOT\Microsoft.XMLHTTP.1.0
HKEY_CLASSES_ROOT\Msxml2.ServerXMLHTTP
HKEY_CLASSES_ROOT\Msxml2.ServerXMLHTTP.3.0
HKEY_CLASSES_ROOT\Msxml2.ServerXMLHTTP.4.0
HKEY_CLASSES_ROOT\Msxml2.ServerXMLHTTP.5.0
HKEY_CLASSES_ROOT\Msxml2.ServerXMLHTTP.6.0
HKEY_CLASSES_ROOT\Msxml2.XMLHTTP
HKEY_CLASSES_ROOT\Msxml2.XMLHTTP.3.0
HKEY_CLASSES_ROOT\Msxml2.XMLHTTP.4.0
HKEY_CLASSES_ROOT\Msxml2.XMLHTTP.5.0
HKEY_CLASSES_ROOT\Msxml2.XMLHTTP.6.0
End of search: 12 match(es) found.

Also be aware there is a limit on how many times you can call any particular XMLHTTP object before a lockout occurs. If that happens, and it does when debugging code, just change to a different xmlhttp object

D.Ddgg
  • 51
  • 2