Google Search Using VBA

Search Webpages using VBA / Search Text in Google using Excel VBA / Programmaticaly search text in Google

This code requires Microsoft Internet Controls reference (Tools > References from code window)

The following function will search for given data in google and save the search as an HTML File. The Timeout parameter is set to 1 min.

Option Explicit

Private ieBrowser As InternetExplorer
Private Const sSite As String = "http://www.google.com/search?q=" ' Change this Appropriately
Private Const sProofPath As String = "d:\temp\" ' Path to Save Searched Pages



Sub Check_Data_From_Google(ByVal sData As String, ByRef sReturn As String, ByRef sSavePath As String)

'Requires Microsoft Internet Controls reference (Tools > References from code window)
Dim sSearchString As String ' Combination of Google Search String + Data
Dim dtStartTime As Date ' Start Time
Dim dtCurrentTime As Date ' Current Time
Dim iMaxWaitTime As Integer ' Maximum waiting time (in Secs)

Dim sDocText ' WebPage as Text
Dim sDocHTML ' WebPage as HTML

On Error GoTo Err_Clearer
' ---------------------------------
' Build the Search String
' ---------------------------------
sSearchString = sSite & sData

' ---------------------------------
' Start Time
' ---------------------------------
Init_IE
dtStartTime = Now
iMaxWaitTime = 60 'Seconds to be waited
ieBrowser.Navigate (sSearchString)

' ieBrowser.Visible = True


Do While ieBrowser.ReadyState <> READYSTATE_COMPLETE 'wait for page to load
DoEvents
dtCurrentTime = Now
' ---------------------------------
' Exit Process if it is taking long time
' ---------------------------------
If DateDiff("s", dtStartTime, dtCurrentTime) > iMaxWaitTime Then sReturn = "TimeOut": Exit Sub
Loop

' Assign the Webpage Results to Variable
sDocText = ieBrowser.Document.documentElement.innertext
sDocHTML = ieBrowser.Document.documentElement.innerhtml

If InStr(sDocText, "did not match any documents") <> 0 Then
sReturn = "NotFound"
Else
If InStr(1, sDocText, sData) <> 0 Then
sReturn = "Found"
Else
sReturn = "NotFound"
End If
End If

sSavePath = sProofPath & sData & "_" & sSpec & ".html"
sSavePath = ClearCharacters(sSavePath)
Open sSavePath For Output As 1
Print #1, sDocHTML
Close #1

Destroy_IE

' -----------------------------
' Error Handler
' -----------------------------
Err_Clearer:
If Err <> 0 Then
Err.Clear
Resume Next
End If

End Sub

Sub Destroy_IE()

On Error GoTo ReInit_IE
ieBrowser.Quit
If Not ieBrowser Is Nothing Then Set ieBrowser = Nothing

Exit Sub

ReInit_IE:

End Sub


Sub Init_IE()

On Error GoTo ReInit_IE

Set ieBrowser = GetObject(, "InternetExplorer.Application")
Exit Sub

ReInit_IE:

Set ieBrowser = CreateObject("internetexplorer.application")
Application.Wait DateAdd("n", 1, Now) ' Wait for one/Two minutes to Start the Browser
End Sub


Function ClearCharacters(ByVal sDirtyString As String) As String

Dim arUnWantedCharacter(1 To 6) As String
Dim IsClear As Boolean
Dim i As Integer
Dim strCleanString As String
Dim j As Integer

arUnWantedCharacter(1) = "/"
arUnWantedCharacter(2) = "/"
arUnWantedCharacter(3) = "?"
arUnWantedCharacter(4) = "*"
arUnWantedCharacter(5) = "["
arUnWantedCharacter(6) = "]"

IsClear = True

strCleanString = vbNullString
For i = 1 To UBound(arUnWantedCharacter)
If InStr(1, sDirtyString, arUnWantedCharacter(i)) Then
IsClear = False
For j = 1 To Len(sDirtyString)
If Mid$(sDirtyString, j, 1) <> arUnWantedCharacter(i) Then
strCleanString = strCleanString & Mid$(sDirtyString, j, 1)
End If
Next j
sDirtyString = strCleanString
End If
Next i

If IsClear = True Then strCleanString = sDirtyString

Finally:


ClearCharacters = strCleanString

End Function


Excel VBA save the search as an HTML File. The function uses innerhtml to get the searched webpage and saves it in the mentioned location

Save Webpage using VBA, VBA Save Webpage (without images) using Excel VBA


See also http://vbadud.blogspot.com/2009/08/how-to-login-to-website-using-vba.html