Automated google search

[Andreas]

Hi all,

I want to conduct automated google searches with keywords that are
saved in column B of my Excel sheet. Now, for each keyword, I would
like to save the "number of results" that Google finds in my Excel
sheet.

Let's assume I start with the keyword "soccer" in cell B2. Then, I
want to have the number of results found by Google saved in cell B3.
Then, Excel should move on to the next row (column B3, and so on).

I've no experience in VBA but I found a code snippet that kind of does
what I want. However, it does not give me the number of results and
does not move on to the next row. But it is a start.

Thanks in advance for your help.

Andreas

Option Explicit

Public Sub GoogleSearch()
'Use and input box for typing in the search words
Dim szSearchWords As String
Dim szResults As String
szSearchWords = Range("B2").Value

If Not Len(szSearchWords) > 0 Then Exit Sub

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

Dim ie As Object 'InternetExplorer
Set ie = CreateObject("InternetExplorer.Application")
ie.Navigate "http://www.google.com/search?hl=en&q=" & _
szSearchWords & "&meta="

'Loop until the page is fully loaded
Const READYSTATE_COMPLETE = 4
Do Until ie.ReadyState = READYSTATE_COMPLETE
With ie
.Visible = True
End With
Loop

'Explicitly clear memory
Set ie = Nothing
End Sub

 

[Joel]

See if these modification help


Public Sub GoogleSearch1()
'Use and input box for typing in the search words
Dim szSearchWords As String
Dim szResults As String
With Sheets("Sheet1")
szSearchWords = .Range("B2").Value
End With
If Not Len(szSearchWords) > 0 Then Exit Sub

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

Dim ie As Object 'InternetExplorer
Set ie = CreateObject("InternetExplorer.Application")
ie.Navigate "http://www.google.com/search?hl=en&q=" & _
szSearchWords & "&meta="

'Loop until the page is fully loaded
Const READYSTATE_COMPLETE = 4
Do Until ie.ReadyState = READYSTATE_COMPLETE
With ie
.Visible = True
End With
Loop

Set Results = ie.document.getelementsbytagname("P")
For Each itm In Results
If InStr(UCase(itm.innertext), "RESULTS") Then
MsgBox (itm.innertext)
Exit For
End If
Next itm

With Sheets("Sheet2")
RowCount = 1
For Each itm In ie.document.all
.Range("A" & RowCount) = itm.tagname
.Range("B" & RowCount) = itm.classname
.Range("C" & RowCount) = Left(itm.innertext, 1024)

RowCount = RowCount + 1
Next itm
.Cells.VerticalAlignment = xlTop
End With

Set Results = ie.document.getelementsbytagname("LI")
With Sheets("Sheet3")
RowCount = 1
For Each itm In Results
.Range("A" & RowCount) = itm.innertext
RowCount = RowCount + 1
Next itm
.Cells.VerticalAlignment = xlTop
End With
'Explicitly clear memory
Set ie = Nothing
End Sub

 

[graefe.andreas]

Thanks Joel.

Not really. I only want the number of results per keyword in column B.
The variable itm.innertext gives me back too much. Also, there is no
loop to move to the next keyword in column B.

Again, let me explain what the problem is. I have a column with
keywords (B). For each keyword, I want to save the number of results
derived from google in column C.

B C
soccer [number of results from google]
tennis [number of results from google]
hockey [number of results from google]

I changed your code a little bit (defined some variables) but it still
doesn't work. Any further ideas?

Andreas

Public Sub GoogleSearch1()
'Use and input box for typing in the search words
Dim szSearchWords As String
Dim szResults As String
Dim Results As Object
Dim itm As Object
Dim RowCount As Integer


With Sheets("Tabelle1")
szSearchWords = .Range("B2").Value
End With
If Not Len(szSearchWords) > 0 Then Exit Sub

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

Dim ie As Object 'InternetExplorer
Set ie = CreateObject("InternetExplorer.Application")
ie.Navigate "http://www.google.com/search?hl=en&q=" & _
szSearchWords & "&meta="

'Loop until the page is fully loaded
Const READYSTATE_COMPLETE = 4
Do Until ie.ReadyState = READYSTATE_COMPLETE
With ie
.Visible = True
End With
Loop

Set Results = ie.document.getelementsbytagname("P")
With Sheets("Tabelle1")
RowCount = 2
For Each itm In Results
.Range("D" & RowCount) = itm.innertext
RowCount = RowCount + 1
Next itm
End With


'Explicitly clear memory
Set ie = Nothing
End Sub

 

[Joel]

Try these changes

Public Sub GoogleSearch()
'Use and input box for typing in the search words
Dim szSearchWords As String
Dim szResults As String
Dim ie As Object 'InternetExplorer

Set ie = CreateObject("InternetExplorer.Application")
ie.Visible = True

With Sheets("Sheet1")
RowCount = 2
Do While .Range("B" & RowCount) <> ""

szSearchWords = .Range("B" & RowCount).Value


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


ie.Navigate "http://www.google.com/search?hl=en&q=" & _
szSearchWords & "&meta="

'Loop until the page is fully loaded
Const READYSTATE_COMPLETE = 4
Do Until ie.ReadyState = READYSTATE_COMPLETE
DoEvents

Loop

Set Results = ie.document.getelementsbytagname("P")
For Each itm In Results
If InStr(UCase(itm.innertext), "RESULTS") Then
MsgBox (itm.innertext)
'really item 3, but arrays staarts at 0
NumberofResults = itm.Children.Item(2).innertext
.Range("C" & RowCount) = NumberofResults
Exit For
End If
Next itm
RowCount = RowCount + 1
Loop
End With
'Explicitly clear memory
Set ie = Nothing
End Sub

Thanks Joel.

Not really. I only want the number of results per keyword in column B.
The variable itm.innertext gives me back too much. Also, there is no
loop to move to the next keyword in column B.

Again, let me explain what the problem is. I have a column with
keywords (B). For each keyword, I want to save the number of results
derived from google in column C.

B C
soccer [number of results from google]
tennis [number of results from google]
hockey [number of results from google]

I changed your code a little bit (defined some variables) but it still
doesn't work. Any further ideas?

Andreas

Public Sub GoogleSearch1()
'Use and input box for typing in the search words
Dim szSearchWords As String
Dim szResults As String
Dim Results As Object
Dim itm As Object
Dim RowCount As Integer


With Sheets("Tabelle1")
szSearchWords = .Range("B2").Value
End With
If Not Len(szSearchWords) > 0 Then Exit Sub

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

Dim ie As Object 'InternetExplorer
Set ie = CreateObject("InternetExplorer.Application")
ie.Navigate "http://www.google.com/search?hl=en&q=" & _
szSearchWords & "&meta="

'Loop until the page is fully loaded
Const READYSTATE_COMPLETE = 4
Do Until ie.ReadyState = READYSTATE_COMPLETE
With ie
.Visible = True
End With
Loop

Set Results = ie.document.getelementsbytagname("P")
With Sheets("Tabelle1")
RowCount = 2
For Each itm In Results
.Range("D" & RowCount) = itm.innertext
RowCount = RowCount + 1
Next itm
End With


'Explicitly clear memory
Set ie = Nothing
End Sub

See if these modification help

Public Sub GoogleSearch1()
'Use and input box for typing in the search words
Dim szSearchWords As String
Dim szResults As String
With Sheets("Sheet1")
szSearchWords = .Range("B2").Value
End With
If Not Len(szSearchWords) > 0 Then Exit Sub

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

Dim ie As Object 'InternetExplorer
Set ie = CreateObject("InternetExplorer.Application")
ie.Navigate "http://www.google.com/search?hl=en&q=" & _
szSearchWords & "&meta="

'Loop until the page is fully loaded
Const READYSTATE_COMPLETE = 4
Do Until ie.ReadyState = READYSTATE_COMPLETE
With ie
.Visible = True
End With
Loop

Set Results = ie.document.getelementsbytagname("P")
For Each itm In Results
If InStr(UCase(itm.innertext), "RESULTS") Then
MsgBox (itm.innertext)
Exit For
End If
Next itm

With Sheets("Sheet2")
RowCount = 1
For Each itm In ie.document.all
.Range("A" & RowCount) = itm.tagname
.Range("B" & RowCount) = itm.classname
.Range("C" & RowCount) = Left(itm.innertext, 1024)

RowCount = RowCount + 1
Next itm
.Cells.VerticalAlignment = xlTop
End With

Set Results = ie.document.getelementsbytagname("LI")
With Sheets("Sheet3")
RowCount = 1
For Each itm In Results
.Range("A" & RowCount) = itm.innertext
RowCount = RowCount + 1
Next itm
.Cells.VerticalAlignment = xlTop
End With
'Explicitly clear memory
Set ie = Nothing
End Sub

 

[graefe.andreas]

Joel, this is amazing! Thanks so much!

I'll work with that somewhen the next days. It might be that more
questions come up. But, again, thanks. It seems to work perfectly!

Andreas

Try these changes

Public Sub GoogleSearch()
  'Use and input box for typing in the search words
  Dim szSearchWords As String
  Dim szResults As String
  Dim ie As Object 'InternetExplorer

  Set ie = CreateObject("InternetExplorer.Application")
  ie.Visible = True

  With Sheets("Sheet1")
     RowCount = 2
     Do While .Range("B" & RowCount) <> ""

        szSearchWords = .Range("B" & RowCount).Value

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

        ie.Navigate "http://www.google.com/search?hl=en&q=" &_
                szSearchWords & "&meta="

        'Loop until the page is fully loaded
        Const READYSTATE_COMPLETE = 4
        Do Until ie.ReadyState = READYSTATE_COMPLETE
           DoEvents

        Loop

        Set Results = ie.document.getelementsbytagname("P")
        For Each itm In Results
           If InStr(UCase(itm.innertext), "RESULTS") Then
              MsgBox (itm.innertext)
               'really item 3, but arrays staarts at 0
               NumberofResults = itm.Children.Item(2).innertext
               .Range("C" & RowCount) = NumberofResults
              Exit For
           End If
        Next itm
        RowCount = RowCount + 1
     Loop
  End With
  'Explicitly clear memory
  Set ie = Nothing
End Sub

Thanks Joel.

Not really. I only want the number of results per keyword in column B.
The variable itm.innertext gives me back too much. Also, there is no
loop to move to the next keyword in column B.

Again, let me explain what the problem is. I have a column with
keywords (B). For each keyword, I want to save the number of results
derived from google in column C.

B             C
soccer     [number of results from google]
tennis      [number of results from google]
hockey    [number of results from google]

I changed your code a little bit (defined some variables) but it still
doesn't work. Any further ideas?

Public Sub GoogleSearch1()
  'Use and input box for typing in the search words
  Dim szSearchWords As String
  Dim szResults As String
  Dim Results As Object
  Dim itm As Object
  Dim RowCount As Integer

  With Sheets("Tabelle1")
     szSearchWords = .Range("B2").Value
  End With
  If Not Len(szSearchWords) > 0 Then Exit Sub

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

  Dim ie As Object 'InternetExplorer
  Set ie = CreateObject("InternetExplorer.Application")
  ie.Navigate "http://www.google.com/search?hl=en&q=" & _
                szSearchWords & "&meta="

    'Loop until the page is fully loaded
  Const READYSTATE_COMPLETE = 4
  Do Until ie.ReadyState = READYSTATE_COMPLETE
    With ie
      .Visible = True
    End With
  Loop

  Set Results = ie.document.getelementsbytagname("P")
    With Sheets("Tabelle1")
     RowCount = 2
     For Each itm In Results
        .Range("D" & RowCount) = itm.innertext
        RowCount = RowCount + 1
     Next itm
 End With

  'Explicitly clear memory
  Set ie = Nothing
End Sub

 

[oitbso]

Hi all,

I want to conduct automated google searches with keywords that are
saved in column B of my Excel sheet. Now, for each keyword, I would
like to save the "number of results" that Google finds in my Excel
sheet.

Let's assume I start with the keyword "soccer" in cell B2. Then, I
want to have the number of results found by Google saved in cell B3.
Then, Excel should move on to the next row (column B3, and so on).

I've no experience in VBA but I found a code snippet that kind of does
what I want. However, it does not give me the number of results and
does not move on to the next row. But it is a start.

Thanks in advance for your help.

Andreas

Option Explicit

Public Sub GoogleSearch()
  'Use and input box for typing in the search words
  Dim szSearchWords As String
  Dim szResults As String
  szSearchWords = Range("B2").Value

  If Not Len(szSearchWords) > 0 Then Exit Sub

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

  Dim ie As Object 'InternetExplorer
  Set ie = CreateObject("InternetExplorer.Application")
  ie.Navigate "http://www.google.com/search?hl=en&q=" & _
                szSearchWords & "&meta="

    'Loop until the page is fully loaded
  Const READYSTATE_COMPLETE = 4
  Do Until ie.ReadyState = READYSTATE_COMPLETE
    With ie
      .Visible = True
    End With
  Loop

    'Explicitly clear memory
  Set ie = Nothing
End Sub

Andreas...Here is another variation on a theme. I've borrowed the
code that you and Joel created and removed/inserted a few lines. The
key difference between this approach and your's and Joel's is that I'm
using the "Post" method to obtain the data rather than actually
opening and running IE. If you have a lot of terms to search you will
find that this method is much faster than the IE approach, since you
are not waiting for IE to continually refresh with the next search
term. If you just have a few terms to search the run time advantage
will be minimal. In any case, here's another way to skin the
cat...Ron

Public Sub GoogleSearch()
' Use and input box for typing in the search words
Dim szSearchWords As String

With Sheets("Sheet1")
RowCount = 2
Do While .Range("B" & RowCount) <> ""
szSearchWords = .Range("B" & RowCount).Value

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

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

' Find the number of results and post to sheet
pos_1 = InStr(1, my_var, "b> of", vbTextCompare)
pos_2 = InStr(3 + pos_1, my_var, ">", vbTextCompare)
pos_3 = InStr(pos_2, my_var, "<", vbTextCompare)
NumberofResults = Mid(my_var, 1 + pos_2, (-1 + pos_3 - pos_2))

Range("C" & RowCount) = NumberofResults
RowCount = RowCount + 1
Loop
End With
End Sub