Solved: Search engine

[Airborne]

Hello, on our server files are saved daily. The files have data in textboxes and in cells. When we want to search back in the files, we use Windows search on the map where we think the file is, which contains the data we are looking for.
The question is, is it possible and if so does anyone have a code for a search engine in Excel? So when you hit a button a form will open where you type the word you are looking for and a search will start through the stored files.

[Jacob Hilderbrand]

Try this:

http://www.vbaexpress.com/kb/getarticle.php?kb_id=159

[Airborne]

Jacob this is a great code! The problem is and I'm sorry I have not been clear enough, the words I have to search for are in textboxes in the sheets. We type text in textboxes in the sheets. I've tried the code and it's great for finding data in cells but can I adjust it in a way that it can search for words in textboxes?


Thanks for the help.

[Jacob Hilderbrand]

Instead of getting the search word from the Input Box you can use something like this:
[VBA]Search = Sheet1.TextBox1.Text[/VBA]

[Airborne]

I'm sorry Jacob. I'm not sure I understand. The names of the sheet in the workbooks we save are Data. In your code I've tried [VBA]Prompt = "What do you want to search for in the folder: " & vbNewLine & vbNewLine & Path
Title = "Search Criteria Input"
Search = Sheets("Data").TextBox1.Text
If Search = "" Then
GoTo Canceled
End If[/VBA]

But I get an error. Also there are 6 textboxes (5, 21, 22, 23, 24, 26).

[Jacob Hilderbrand]

But I get an error. Also there are 6 textboxes (5, 21, 22, 23, 24, 26).

Don't refer to the Textbox as Textbox1 if that is the wrong name:

Textbox5
Textbox21
Textbox22
Textbox23
Textbox24
Textbox26

[Airborne]

Jacob, I've tried[VBA] Prompt = "What do you want to search for in the folder: " & vbNewLine & vbNewLine & Path
Title = "Search Criteria Input"
Search = Sheets("Data").TextBox22.Text
Search = Sheets("Data").TextBox23.Text
' InputBox(Prompt, Title)
If Search = "" Then
GoTo Canceled
End If[/VBA]

I get subscript out of range. It wants to search for the workbook name "Data" I guess. The names of the stored files are by date, e.g. 21-10-2004, 22-10-2004, etc. So there are about 30 - 31 files per month stored, in this case in the map Oct. The names of the sheet in the workbooks are called Data and they contain the textboxes

[Jacob Hilderbrand]

So you want to check each workbook in a folder and check certain Text Boxes (in each workbook) for a certain text string?

[Jacob Hilderbrand]

See if this helps you get started.
[vba]
Dim WB As Workbook
Dim FileName As String

FileName = Dir(Path & "\*.xls", vbNormal)
Do Until FileName = ""
On Error Resume Next
Set WB = Workbooks.Open(FileName:=Path & "\" & FileName, ReadOnly:=True, Password:="DRJWasHere")
If Err = 0 Then
On Error GoTo 0
With WB.Sheets("Data")

'Check the values in the Text Boxes here

End With
End If
On Error GoTo 0
WB.Close False
FileName = Dir()
Loop
[/vba]

[Airborne]

Sorry Jacob, I'm just a beginner and I'm lost now. The last code and the first code look like this now[VBA]Option Compare Text
Option Explicit

Private Const BIF_RETURNONLYFSDIRS As Long = &H1
Private Const BIF_DONTGOBELOWDOMAIN As Long = &H2
Private Const BIF_RETURNFSANCESTORS As Long = &H8
Private Const BIF_BROWSEFORCOMPUTER As Long = &H1000
Private Const BIF_BROWSEFORPRINTER As Long = &H2000
Private Const BIF_BROWSEINCLUDEFILES As Long = &H4000
Private Const MAX_PATH As Long = 260

Type BrowseInfo
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszINSTRUCTIONS As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type

Type SHFILEOPSTRUCT
hwnd As Long
wFunc As Long
pFrom As String
pTo As String
fFlags As Integer
fAnyOperationsAborted As Boolean
hNameMappings As Long
lpszProgressTitle As String
End Type

Declare Function SHGetPathFromIDListA Lib "shell32.dll" ( _
ByVal pidl As Long, _
ByVal pszBuffer As String) As Long
Declare Function SHBrowseForFolderA Lib "shell32.dll" ( _
lpBrowseInfo As BrowseInfo) As Long

Function BrowseFolder(Optional Caption As String = "") As String

Dim BrowseInfo As BrowseInfo
Dim FolderName As String
Dim ID As Long
Dim Res As Long

With BrowseInfo
.hOwner = 0
.pidlRoot = 0
.pszDisplayName = String$(MAX_PATH, vbNullChar)
.lpszINSTRUCTIONS = Caption
.ulFlags = BIF_RETURNONLYFSDIRS
.lpfn = 0
End With
FolderName = String$(MAX_PATH, vbNullChar)
ID = SHBrowseForFolderA(BrowseInfo)
If ID Then
Res = SHGetPathFromIDListA(ID, FolderName)
If Res Then
BrowseFolder = Left$(FolderName, InStr(FolderName, _
vbNullChar) - 1)
End If
End If

End Function

Sub FindAll()

Dim WB As Workbook
Dim WS As Worksheet
Dim Cell As Range
Dim Prompt As String
Dim Title As String
Dim Search As String
Dim FindCell() As String
Dim FindSheet() As String
Dim FindWorkBook() As String
Dim FindPath() As String
Dim FindText() As String
Dim Counter As Long
Dim FirstAddress As String
Dim Path As String
Dim MyResponse As VbMsgBoxResult
Dim FileName As String

'*** Get folder from user ***
' Prompt = "Select the folder with the files that you want to search through." & _
' vbNewLine & vbNewLine & "Note: Subfolders will not be searched through."
Title = "Folder Selection"
' MsgBox Prompt, vbInformation, Title

'*** This code works with XP only and is also used to pick a folder ***
'Application.FileDialog(msoFileDialogFolderPicker).Show
'Path = CurDir

Path = BrowseFolder("Select A Folder")
If Path = "" Then
Prompt = "You didn't select a folder. The procedure has been canceled."
Title = "Procedure Canceled"
MsgBox Prompt, vbCritical, Title
GoTo Canceled:
End If

' Prompt = "What do you want to search for in the folder: " & vbNewLine & vbNewLine & Path
Title = "Search Criteria Input"
Search = InputBox(Prompt, Title)
If Search = "" Then
GoTo Canceled
End If

'*** Confirm the procedure before continuing ***
' Prompt = "Are you sure that you want to search all the files in the folder:" & _
' vbCrLf & Path & " for " & """" & Search & """" & "?"
Title = "Confirm Procedure"
' MyResponse = MsgBox(Prompt, vbQuestion + vbYesNo, Title)
' If MyResponse = vbNo Then
' GoTo Canceled:
' End If

Application.DisplayAlerts = False
Application.ScreenUpdating = False

'*** Loop through all Word documents and search each of them for the specified criteria***
FileName = Dir(Path & "\*.xls", vbNormal)
Do Until FileName = ""
On Error Resume Next
Set WB = Workbooks.Open(FileName:=Path & "\" & FileName, ReadOnly:=True, Password:="DRJWasHere")
If Err = 0 Then
On Error GoTo 0
With WB.Sheets("Data")

'Check the values in the Text Boxes here

End With
End If
On Error GoTo 0
WB.Close False
FileName = Dir()
Loop
Canceled:

Set WB = Nothing
Set WS = Nothing
Set Cell = Nothing
Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub[/VBA] But where you say 'Check the values in the Text Boxes here. I don't know what to put there.

[Jacob Hilderbrand]

Try something like this
[VBA]With WB.Sheets("Data")

'Check the values in the Text Boxes here
If .TextBox5.Text = Search Then
'Do Something
Else
'Not Found
End If
If .TextBox21.Text = Search Then
'Do Something
Else
'Not Found
End If
If .TextBox22.Text = Search Then
'Do Something
Else
'Not Found
End If



End With [/VBA]

[Airborne]

After I've selected the directory and entered the word I want to look for, it just opens a .xls file in the directory and then in line If .TextBox5.Text = Search Then I get the error "object doesn't support this property of method".

It should also, only open a file, if the word where I searched for is found.

:no I think this is more VBA than I can handle.

Thanks for the help.

[Jacob Hilderbrand]

Ok, try this one. Note that there is currently no error handling to take care of the Text Boxes possibly not existing on the Sheet named Data in each workbook.
[vba]
Option Compare Text
Option Explicit

Private Const BIF_RETURNONLYFSDIRS As Long = &H1
Private Const BIF_DONTGOBELOWDOMAIN As Long = &H2
Private Const BIF_RETURNFSANCESTORS As Long = &H8
Private Const BIF_BROWSEFORCOMPUTER As Long = &H1000
Private Const BIF_BROWSEFORPRINTER As Long = &H2000
Private Const BIF_BROWSEINCLUDEFILES As Long = &H4000
Private Const MAX_PATH As Long = 260

Type BrowseInfo
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszINSTRUCTIONS As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type

Type SHFILEOPSTRUCT
hwnd As Long
wFunc As Long
pFrom As String
pTo As String
fFlags As Integer
fAnyOperationsAborted As Boolean
hNameMappings As Long
lpszProgressTitle As String
End Type

Declare Function SHGetPathFromIDListA Lib "shell32.dll" ( _
ByVal pidl As Long, _
ByVal pszBuffer As String) As Long
Declare Function SHBrowseForFolderA Lib "shell32.dll" ( _
lpBrowseInfo As BrowseInfo) As Long

Function BrowseFolder(Optional Caption As String = "") As String

Dim BrowseInfo As BrowseInfo
Dim FolderName As String
Dim ID As Long
Dim Res As Long

With BrowseInfo
.hOwner = 0
.pidlRoot = 0
.pszDisplayName = String$(MAX_PATH, vbNullChar)
.lpszINSTRUCTIONS = Caption
.ulFlags = BIF_RETURNONLYFSDIRS
.lpfn = 0
End With
FolderName = String$(MAX_PATH, vbNullChar)
ID = SHBrowseForFolderA(BrowseInfo)
If ID Then
Res = SHGetPathFromIDListA(ID, FolderName)
If Res Then
BrowseFolder = Left$(FolderName, InStr(FolderName, _
vbNullChar) - 1)
End If
End If

End Function

Sub FindAll()

Dim WB As Workbook
Dim WS As Worksheet
Dim Cell As Range
Dim Prompt As String
Dim Title As String
Dim Search As String
Dim FindCell() As String
Dim FindSheet() As String
Dim FindWorkBook() As String
Dim FindPath() As String
Dim FindText() As String
Dim Counter As Long
Dim FirstAddress As String
Dim Path As String
Dim MyResponse As VbMsgBoxResult
Dim FileName As String

'*** Get folder from user ***
' Prompt = "Select the folder with the files that you want to search through." & _
' vbNewLine & vbNewLine & "Note: Subfolders will not be searched through."
Title = "Folder Selection"
' MsgBox Prompt, vbInformation, Title

'*** This code works with XP only and is also used to pick a folder ***
'Application.FileDialog(msoFileDialogFolderPicker).Show
'Path = CurDir

Path = BrowseFolder("Select A Folder")
If Path = "" Then
Prompt = "You didn't select a folder. The procedure has been canceled."
Title = "Procedure Canceled"
MsgBox Prompt, vbCritical, Title
GoTo Canceled:
End If

Prompt = "What do you want to search for in the folder: " & vbNewLine & vbNewLine & Path
Title = "Search Criteria Input"
Search = InputBox(Prompt, Title)
If Search = "" Then
GoTo Canceled
End If

'*** Confirm the procedure before continuing ***
' Prompt = "Are you sure that you want to search all the files in the folder:" & _
' vbCrLf & Path & " for " & """" & Search & """" & "?"
Title = "Confirm Procedure"
' MyResponse = MsgBox(Prompt, vbQuestion + vbYesNo, Title)
' If MyResponse = vbNo Then
' GoTo Canceled:
' End If

Application.DisplayAlerts = False
Application.ScreenUpdating = False

'*** Loop through all Word documents and search each of them for the specified criteria***
FileName = Dir(Path & "\*.xls", vbNormal)
Do Until FileName = ""
On Error Resume Next
Set WB = Workbooks.Open(FileName:=Path & "\" & FileName, ReadOnly:=True, Password:="DRJWasHere")
On Error GoTo 0
'Cannot Open Workbook
If WB Is Nothing Then
GoTo NextLoop:
End If
On Error Resume Next
Set WS = WB.Sheets("Data")
On Error GoTo 0
If WS Is Nothing Then
WB.Close False
GoTo NextLoop:
End If
With WB.Sheets("Data")
'Check the values in the Text Boxes here
If .TextBox5.Text = Search Or _
.TextBox21.Text = Search Or _
.TextBox22.Text = Search Or _
.TextBox23.Text = Search Or _
.TextBox24.Text = Search Or _
.TextBox26.Text = Search Then
'Do Something
'Just keep the file open
Else
'Not Found
WB.Close False
End If
End With

NextLoop:
Set WB = Nothing
Set WS = Nothing
FileName = Dir()
Loop
Canceled:

Set WB = Nothing
Set WS = Nothing
Set Cell = Nothing
Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub
[/vba]

[Airborne]

You must be getting tired of my replies but it doesn't work. I get the error message "object doesn't support this property of method".

What do you mean by "Note that there is currently no error handling to take care of the Text Boxes possibly not existing on the Sheet named Data in each workbook"?

What I don't understand is that the routine just opens .xls files in the selected directory. It must open a file only, when it finds the text I'm searching for in one of the textboxes, on the sheet named Data, in the workbook Data_ddmmjjj.

In the directory are about 30 - 31 workbooks named Data_ddmmjjj all containing 3 sheets and one of those sheets is called Data containing the mentioned textboxes. I hope I'm clear enough .

Thanks for your patience.

[mdmackillop]

Hi,
Try the following variation of the FindAll sub. It does depend upon how your system names the textboxes. If there is a problem, can you zip up a workbook containing a suitable "Data" page and post it here. (You can delete all the data on the sheet if you wish, as it is unnecessary)

[VBA]
Sub FindAll()

Dim WB As Workbook
Dim WS As Worksheet
Dim Cell As Range
Dim Prompt As String
Dim Title As String
Dim Search As String
Dim FindCell() As String
Dim FindSheet() As String
Dim FindWorkBook() As String
Dim FindPath() As String
Dim FindText() As String
Dim Counter As Long
Dim FirstAddress As String
Dim Path As String
Dim MyResponse As VbMsgBoxResult
Dim FileName As String
Dim Test As Boolean
Dim MyWS
Dim shp
Dim i As Integer
Dim BoxText As String

'*** Get folder from user ***
' Prompt = "Select the folder with the files that you want to search through." & _
' vbNewLine & vbNewLine & "Note: Subfolders will not be searched through."
Title = "Folder Selection"
' MsgBox Prompt, vbInformation, Title

'*** This code works with XP only and is also used to pick a folder ***
'Application.FileDialog(msoFileDialogFolderPicker).Show
'Path = CurDir

Path = BrowseFolder("Select A Folder")
If Path = "" Then
Prompt = "You didn't select a folder. The procedure has been canceled."
Title = "Procedure Canceled"
MsgBox Prompt, vbCritical, Title
GoTo Canceled:
End If

Prompt = "What do you want to search for in the folder: " & vbNewLine & vbNewLine & Path
Title = "Search Criteria Input"
Search = InputBox(Prompt, Title)
If Search = "" Then
GoTo Canceled
End If

'*** Confirm the procedure before continuing ***
' Prompt = "Are you sure that you want to search all the files in the folder:" & _
' vbCrLf & Path & " for " & """" & Search & """" & "?"
Title = "Confirm Procedure"
' MyResponse = MsgBox(Prompt, vbQuestion + vbYesNo, Title)
' If MyResponse = vbNo Then
' GoTo Canceled:
' End If

Application.DisplayAlerts = False
Application.ScreenUpdating = False

'*** Loop through all Word documents and search each of them for the specified criteria***
FileName = Dir(Path & "\*.xls", vbNormal)

Do Until FileName = ""
On Error Resume Next
Set WB = Workbooks.Open(FileName:=Path & "\" & FileName, ReadOnly:=True, Password:="DRJWasHere")
On Error GoTo 0
'Cannot Open Workbook
If WB Is Nothing Then
GoTo NextLoop:
End If
On Error Resume Next
Set WS = WB.Sheets("Data")
On Error GoTo 0
If WS Is Nothing Then
WB.Close False
GoTo NextLoop:
End If
Set MyWS = WB.Sheets("Data")
Test = False
'Check the values in the Text Boxes here
For i = 1 To MyWS.Shapes.Count
' Debug.Print MyWS.Shapes(i).Name
BoxText = MyWS.Shapes(i).TextFrame.Characters.Text
If Left(MyWS.Shapes(i).Name, 8) = "Text Box" Then
If InStr(1, BoxText, Search) > 0 Then
Test = True
GoTo NextLoop
End If
End If
Next

NextLoop:
If Test = False Then WB.Close False
Set WB = Nothing
Set WS = Nothing
FileName = Dir()
Debug.Print FileName
Loop
Canceled:

Set WB = Nothing
Set WS = Nothing
Set Cell = Nothing
Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

[/VBA]

[Airborne]

Still not working, it just opens the first file where the text is not in and then returns the error I mentioned before. I'll attach a zipped file.

[mdmackillop]

Anticipated problem with the TextBox names,
Change this line
[VBA]If Left(MyWS.Shapes(i).Name, 8) = "Text Box" Then
[/VBA]
to
[VBA] If Left(MyWS.Shapes(i).Name, 4) = "Text" Then[/VBA]

I've not set the code to check sheets only named Data.... Is this required?

[Airborne]

No, it just opens a file (it doesn't seem to bother about the text I search for) and then I get the usual error but now at line "BoxText = MyWS.Shapes(i).TextFrame.Characters.Text".

[mdmackillop]

It may be a version problem, I'm on 2000. What version of Excel are you using?

[Airborne]

I use 2003 and WindowsXP