grizzlyjdw2
Registered User.
- Local time
- Today, 06:18
- Joined
- Feb 26, 2009
- Messages
- 22
ok, i am trying to search word documents, which i was able to do successfully, but the search is SLOW! it takes about a second per word per file. i am thinking that being as it is using word to open the files (i think anyway) that that is what is causing it to be slow. anyway, here is my search function as well as the code that accesses it:
Public Function FindText(strSearch As String, FilePath As String) As Boolean
'PMatchWord As Boolean, PMatchCase As Boolean
'searches through word documents for strings
'call from a query
'need a table with paths to documents
'Parameters
'strSearch - String to search for
'FilePath - Path of document ex. C:\Test.doc
'PMatchWord - True or False (Match entire string)
'PMatchCase - True or False (Match case of letters in string)
On Error GoTo FindText_Err
Dim WordObj As word.Application
Dim DocObj As word.Document
'variable declarations
'Dim words() As String
'Dim i As Integer
'Dim phrase As String
'phrase = strSearch
'seperate the phrase into words
'words = Split(phrase)
'Create Word Application Object
Set WordObj = CreateObject("Word.Application")
'Create Word Document Object - Open the document represented by FilePath
Set DocObj = WordObj.Documents.Open(FilePath)
'The Selection property returns the selection Object
'The Selection Object refers to the selected text
'If there is no selected text it refers to the insertion point (Where the cursor is)
'Since the document was just opened the cursor is at the start or the document
'Find Selected Text
'If Found the text will be selected
With WordObj.Selection.Find
.Forward = True
.ClearFormatting
.MatchWholeWord = True 'PMatchWord
.MatchCase = False 'PMatchCase
.Wrap = wdFindContinue
.Execute FindText:=strSearch
End With
'If the string was found it is now referred back by the Selection property
If WordObj.Selection.Text = strSearch Then
FindText = True
'MsgBox ("true")
Else
FindText = False
'MsgBox ("false")
End If
FindText_Exit:
'Clean up memory
'Close Document without saving (False)
DocObj.Close False
Set DocObj = Nothing
'Close Word without saving (False)
WordObj.Quit False
Set WordObj = Nothing
Exit Function
FindText_Err:
Resume FindText_Exit
End Function
code calling the search (breaks string into seperate words and places them in array)
'***VARIABLE DECLARATIONS***
Dim word_array() As String ' array of words taken from the phrase string
Dim phrase As String ' phrase input by the user
Dim word_count As Integer ' counter variable for words
Dim path_count As Integer ' counter variable for paths
Dim result As Boolean ' found or not
Dim path As String ' path of files found
Dim directory As String 'directory to search
Dim category As String ' category input from drop down
Dim N
f_Files As Integer
Set Varset = CurrentDb.OpenRecordset("SELECT results.* FROM results;") 'dataset to use for results
'***CHECK TO SEE IF CATEGORY WAS ENTERED***
If (IsNull(cat_combo)) Then
MsgBox "you did not select a category"
GoTo End_sub:
End If
category = cat_combo
'***GET DIRECTORY TO SEARCH***
directory = FindDirectory(category)
'MsgBox (directory) 'error check to ensure the path is pulling properly
'CODE TO GET EACH FILE OUT OF A GIVEN DIRECTORY
With Application.FileSearch
.NewSearch
.LookIn = directory
.FileName = "*.doc"
.SearchSubFolders = True
.Execute
N
f_Files = .FoundFiles.Count
'MsgBox ("number of files") 'check to see number of files being pulled
' MsgBox N
f_Files ' check to see number of files being pulled
'END
'***CHECK TO SEE IF SEARCH CRITERIA WAS ENTERED***
If IsNull(Me!Text1) Then
MsgBox ("please enter search criteria")
GoTo End_sub:
End If
phrase = Me![Text1] 'set phrase to search input from form
word_array = Split(phrase) 'split the search phrase into individual words
For path_count = 1 To N
f_Files
'MsgBox (.FoundFiles(path_count)) 'check to see each file being checked
'***LOOP THROUGH THE WORD ARRAY***
For word_count = LBound(word_array) To UBound(word_array)
If (word_array(word_count) = "") Then
GoTo end_loop:
Else
'code to go through each word in the array
'MsgBox (word_array(word_count)) ' test to see if words are seperating correctly
result = FindText(word_array(word_count), .FoundFiles(path_count))
'MsgBox .FoundFiles(path_count)
'MsgBox word_array(word_count)
If result = True Then
Varset.AddNew
Varset!FilePath = .FoundFiles(path_count)
Varset.Update
End If
End If
end_loop:
Next
'***END LOOP***
Next path_count
End With
DoCmd.OpenForm ("result_form")
End_sub:
Erase word_array
End Sub
any help would be appriciated
Public Function FindText(strSearch As String, FilePath As String) As Boolean
'PMatchWord As Boolean, PMatchCase As Boolean
'searches through word documents for strings
'call from a query
'need a table with paths to documents
'Parameters
'strSearch - String to search for
'FilePath - Path of document ex. C:\Test.doc
'PMatchWord - True or False (Match entire string)
'PMatchCase - True or False (Match case of letters in string)
On Error GoTo FindText_Err
Dim WordObj As word.Application
Dim DocObj As word.Document
'variable declarations
'Dim words() As String
'Dim i As Integer
'Dim phrase As String
'phrase = strSearch
'seperate the phrase into words
'words = Split(phrase)
'Create Word Application Object
Set WordObj = CreateObject("Word.Application")
'Create Word Document Object - Open the document represented by FilePath
Set DocObj = WordObj.Documents.Open(FilePath)
'The Selection property returns the selection Object
'The Selection Object refers to the selected text
'If there is no selected text it refers to the insertion point (Where the cursor is)
'Since the document was just opened the cursor is at the start or the document
'Find Selected Text
'If Found the text will be selected
With WordObj.Selection.Find
.Forward = True
.ClearFormatting
.MatchWholeWord = True 'PMatchWord
.MatchCase = False 'PMatchCase
.Wrap = wdFindContinue
.Execute FindText:=strSearch
End With
'If the string was found it is now referred back by the Selection property
If WordObj.Selection.Text = strSearch Then
FindText = True
'MsgBox ("true")
Else
FindText = False
'MsgBox ("false")
End If
FindText_Exit:
'Clean up memory
'Close Document without saving (False)
DocObj.Close False
Set DocObj = Nothing
'Close Word without saving (False)
WordObj.Quit False
Set WordObj = Nothing
Exit Function
FindText_Err:
Resume FindText_Exit
End Function
code calling the search (breaks string into seperate words and places them in array)
'***VARIABLE DECLARATIONS***
Dim word_array() As String ' array of words taken from the phrase string
Dim phrase As String ' phrase input by the user
Dim word_count As Integer ' counter variable for words
Dim path_count As Integer ' counter variable for paths
Dim result As Boolean ' found or not
Dim path As String ' path of files found
Dim directory As String 'directory to search
Dim category As String ' category input from drop down
Dim N
Set Varset = CurrentDb.OpenRecordset("SELECT results.* FROM results;") 'dataset to use for results
'***CHECK TO SEE IF CATEGORY WAS ENTERED***
If (IsNull(cat_combo)) Then
MsgBox "you did not select a category"
GoTo End_sub:
End If
category = cat_combo
'***GET DIRECTORY TO SEARCH***
directory = FindDirectory(category)
'MsgBox (directory) 'error check to ensure the path is pulling properly
'CODE TO GET EACH FILE OUT OF A GIVEN DIRECTORY
With Application.FileSearch
.NewSearch
.LookIn = directory
.FileName = "*.doc"
.SearchSubFolders = True
.Execute
N
'MsgBox ("number of files") 'check to see number of files being pulled
' MsgBox N
'END
'***CHECK TO SEE IF SEARCH CRITERIA WAS ENTERED***
If IsNull(Me!Text1) Then
MsgBox ("please enter search criteria")
GoTo End_sub:
End If
phrase = Me![Text1] 'set phrase to search input from form
word_array = Split(phrase) 'split the search phrase into individual words
For path_count = 1 To N
'MsgBox (.FoundFiles(path_count)) 'check to see each file being checked
'***LOOP THROUGH THE WORD ARRAY***
For word_count = LBound(word_array) To UBound(word_array)
If (word_array(word_count) = "") Then
GoTo end_loop:
Else
'code to go through each word in the array
'MsgBox (word_array(word_count)) ' test to see if words are seperating correctly
result = FindText(word_array(word_count), .FoundFiles(path_count))
'MsgBox .FoundFiles(path_count)
'MsgBox word_array(word_count)
If result = True Then
Varset.AddNew
Varset!FilePath = .FoundFiles(path_count)
Varset.Update
End If
End If
end_loop:
Next
'***END LOOP***
Next path_count
End With
DoCmd.OpenForm ("result_form")
End_sub:
Erase word_array
End Sub
any help would be appriciated