Option Compare Text
Option Explicit
Public InClause As String
Private IntAnd As Integer
Private SearchItem As Variant
Function MySearch(SearchWord As String, _
StrTable As String, _
SearchField As String, _
RecordID As String, _
Optional IdAsString As Boolean = False) As Boolean
Dim varItem As Variant
Dim x As Variant
If InStr(SearchWord, " ") > 0 Then
SearchItem = Split(SearchWord, " ")
' Pass on the search to MultiSearch
MySearch = MultiSearch(SearchWord, StrTable, SearchField, RecordID, IdAsString)
Exit Function
End If
InClause = vbNullString
With CurrentDb.OpenRecordset("Select [" & RecordID & "]," & "[" & SearchField & "] From [" & StrTable & "]", dbOpenSnapshot)
If .RecordCount > 0 Then
Do Until .EOF
' First check to see if there are more than one word, if so split it into an array
If InStr(.Fields(1), " ") > 0 Then
varItem = Split(.Fields(1), " ")
'Split all the words into an array and search the array to find the searchword
For Each x In varItem
'Check to see if the word is perhaps at the end of a sentence and do a check with the
'ending character removed
If IsWordEnd(Right(x, 1)) Then
If StrComp(SearchWord, Left(x, Len(x) - 1), vbTextCompare) = 0 Then
AddInClause .Fields(0), IdAsString
Exit For
End If
Else
If StrComp(SearchWord, x, vbTextCompare) = 0 Then
AddInClause .Fields(0), IdAsString
Exit For
End If
End If
Next
.MoveNext
Else
'If there is only one word in the record, check for a match and move on to the next record
If IsWordEnd(Right(.Fields(1), 1)) Then
If StrComp(SearchWord, Left(.Fields(1), Len(.Fields(1)) - 1), vbTextCompare) = 0 Then
AddInClause .Fields(0), IdAsString
End If
Else
If StrComp(SearchWord, .Fields(1), vbTextCompare) = 0 Then
AddInClause .Fields(0), IdAsString
End If
End If
.MoveNext
End If
Loop
End If
End With
'Finally if we found any records, remove the trailing comma from InClause-string variable
If Len(InClause) > 0 Then
InClause = Left(InClause, Len(InClause) - 1)
MySearch = True
Else
MySearch = False
End If
End Function
Function MultiSearch(SearchWord As String, _
StrTable As String, _
SearchField As String, _
RecordID As String, _
Optional IdAsString As Boolean = False) As Boolean
Dim varItem As Variant
Dim i As Variant
Dim x As Variant
InClause = vbNullString
IntAnd = 0
With CurrentDb.OpenRecordset("Select [" & RecordID & "]," & "[" & SearchField & "] From [" & StrTable & "]", dbOpenSnapshot)
If .RecordCount > 0 Then
Do Until .EOF
' First check to see if there are more than one word, if so split it into an array
If InStr(.Fields(1), " ") > 0 Then
varItem = Split(.Fields(1), " ")
For Each i In SearchItem
'Split all the words into an array and search the array to find the searchword
For Each x In varItem
If IsWordEnd(Right(x, 1)) Then
If StrComp(i, Left(x, Len(x) - 1), vbTextCompare) = 0 Then
IntAnd = IntAnd + 1
End If
Else
If StrComp(i, x, vbTextCompare) = 0 Then
IntAnd = IntAnd + 1
Else
IntAnd = IntAnd + 0
End If
End If
Next x
Next i
If IntAnd = UBound(SearchItem) + 1 Then
AddInClause .Fields(0), IdAsString
IntAnd = 0
.MoveNext
Else
IntAnd = 0
.MoveNext
End If
Else
'If there is only one word in the record, move on to the next record
IntAnd = 0
.MoveNext
End If
Loop
End If
End With
'Finally if we found any records, remove the trailing comma from InClause-string variable
If Len(InClause) > 0 Then
InClause = Left(InClause, Len(InClause) - 1)
MultiSearch = True
Else
MultiSearch = False
End If
ExitPoint:
Set SearchItem = Nothing
End Function
Private Sub AddInClause(RecordID As Variant, IsIdString As Boolean)
If IsIdString Then
InClause = InClause & Chr(34) & RecordID & Chr(34) & ","
Else
InClause = InClause & RecordID & ","
End If
End Sub
Function IsWordEnd(AnyString As String) As Boolean
Select Case AnyString
Case ".", " ", ",", ";", "/", ":"
IsWordEnd = True
Case Else
IsWordEnd = False
End Select
End Function
