Parse String for Specific Keywords

[DataJoe]

I have a continuous form where one can search an inventory table (item description) for specific keywords by typing the same into an unbound text box (FindBox). I have a hidden text box (ExactWord) with a Control Source of =ParseText([FindBox],0). And a command button on the form for finding the matches with the code: DoCmd.ApplyFilter ,
"InStr(1,[qryInventory].[Item],Forms!frmInventory!ExactWord)"

It works fine except it also includes other words that contain part of the searched one. For example, the word "red" that can be found in: manufactu'red', colo'red', etc. By changing the (ExactWord) Control Source to: =Chr(32) & [FindBox] & Chr(32), it found the exact word "red" but, of course, it EXcluded records where it appeared at the beginning or end of a string, or with quotes around it, etc.

I would like to include both into one function and this is where I need assistance. It is for an Access 97 db so the Split()function is not available. However, I have found code for a claimed substitute split function shown below, if needed.

Here is the code for the ParseText() function:

Public Function ParseText( _
List As Variant, _
Item As Long) As Variant

'Returns a specified word from a string.

Dim oRE As Object 'VBScript_RegExp_55.RegExp
Dim oMatches As Object 'VBScript_RegExp_55.MatchCollection

If IsNull(List) Then
ParseText = Null
Exit Function
End If

Set oRE = CreateObject("VBScript.Regexp")
With oRE
.Pattern = "\b[-0-9A-Z_]+\b"
.Global = True
.IgnoreCase = True
.Multiline = True
End With

Set oMatches = oRE.Execute(CStr(List))
If oMatches.Count <= Item Then
ParseText = Null
Else
ParseText = oMatches(Item)
End If

Set oRE = Nothing
End Function


Here is the code for the Split() function that I found (note that I changed the name to Split2).

Public Function Split2( _
Expression As String, _
Optional Delimiter As String = " ", _
Optional ByVal Limit As Long = -1, _
Optional ByVal Compare As Integer = 0) _
As Variant
'------------------------------------------------------
' Inputs: String to search,
' delimiter string,
' optional replacement limit (default = -1 .. ALL)
' optional string compare value (default vbBinaryCompare)
' Outputs: Array containing items found in the string
' based on the delimiter provided
' Original code by: John L. Viescas 5-Sep-2001
' Extensively revised by: Dirk Goldgar 21-Jan-2002
' Last Revision: Dirk Goldgar 21-Jan-2002
' ** Duplicates the functionality of the VB 6 SPLIT function.
'-------------------------------------------------------
Dim lngCnt As Long
Dim intIndex As Integer
Dim lngPos As Long
Dim lngI As Long
Dim strArray() As String

If (Compare < -1) Or (Compare > 2) Then
err.Raise 5
Exit Function
End If
' If count is zero, return an empty array
If Limit = 0 Then
Split2 = Array()
Exit Function
End If
' If the Delimiter is zero-length, return a 1-entry array
If Len(Delimiter) = 0 Then
ReDim strArray(0)
strArray(0) = Expression
Split2 = strArray
Exit Function
End If

' Start count at (Limit - 1) because function returns
' whatever is left at the end.
lngCnt = Limit - 1
' Start scanning at the start of the string.
lngPos = 1
' Loop until the counter is zero.
Do Until lngCnt = 0
lngI = InStr(lngPos, Expression, Delimiter, Compare)
' If the delimiter was not found, end the loop.
If lngI = 0 Then Exit Do
' Add 1 to the number returned.
intIndex = intIndex + 1
' Expand the array to fit in a new element.
ReDim Preserve strArray(0 To intIndex - 1)
' Use index - 1 .. zero-based array
strArray(intIndex - 1) = Mid$(Expression, lngPos, lngI -

lngPos)
' Advance past the found entry and the delimiter.
lngPos = lngI + Len(Delimiter)
lngCnt = lngCnt - 1
Loop
' Everything after the last delimiter found goes in the last entry of
' the array.
intIndex = intIndex + 1
ReDim Preserve strArray(0 To intIndex - 1)
If lngPos <= Len(Expression) Then
strArray(intIndex - 1) = Mid$(Expression, lngPos)
Else
strArray(intIndex - 1) = vbNullString
End If

' Return the result
Split2 = strArray
End Function


Note: Below I made some attempt to modifiy the ParseText function with code to look for a specific word separated by a space or a separator, but without success. I prefer combining the two functions.

Public Function ParseText2( _
List As Variant, _
Item As Long, _
Optional Separator As String = " " _
) As Variant

Dim arWords As Variant

If IsNull(List) Then
ParseText2 = Null
Exit Function
End If

arWords = Split2(CStr(List), Separator, Item + 2)
If UBound(arWords) < Item Then
ParseText2 = Null
Else
ParseText2 = arWords(Item)
End If
End Function


Any assistance will be much appreciated. Thanks.

DataJoe

 

[vbajock]

I've solved problems like that using a For Next Loop controlled by the length of the string being searched, something like this:

Public Function SomeSearchFunction(byval StringToSearch, StringToSearchFor)

Dim int as integer
Dim sCurResult as string

'Example "Mary found a red Fox" find "red"


For int=0 to len(StringToSearch)-1

CurResult=CurResult+Ucase$(Mid$(StringToSearch,int,1)) 'convert all letters to upper case

'int=0, CurResultt = M
'int=1 CurResultt = A


if CurResult=Chr$(32) then 'found a space
if ucase$(CurResult)=ucase$(StringToSearchFor) then
msgbox "Found it!"
else
CurResult="" ' go to next word
end if
end if

End Function

Next I


End Function

 

[vbajock]

Note that code is not debugged, there is an extra End Function in the Next loop, delete that