Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations gkittelson on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Parse String for Specific Keywords

Status
Not open for further replies.

DataJoe

Technical User
May 25, 2009
1
US
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

 
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



 
Note that code is not debugged, there is an extra End Function in the Next loop, delete that
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top