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 = "C:\Users\user\Desktop" ' Path to Save Searched Pages
Sub Test()
Check_Data_From_Google "Eric", sSite, sProofPath
End Sub
Function Check_Data_From_Google(ByRef 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 = 10 '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 Function
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 & ".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 Function
Sub Destroy_IE()
On Error GoTo ReInit_IE
ieBrowser.Quit
If Not ieBrowser Is Nothing Then Set ieBrowser = Nothing
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
