vb6 select whole word in string - regex

Question

I am trying to search a string without regex perhaps a bad idea !
The search is acting on a string of text in a RichText Box
If I search for "is" the first word in the String is "This"
The last two letters of "This" is are highlighted in vbRed
The string to be searched has two other occurrences of "is" and these are found and highlighted as expected
The question can I prevent the "is" in "This" from being found?
Private Sub btnSearch_Click()
Dim pos As Integer
Dim strToFind As String
Dim Y As Integer
Dim Ask As String
pos = 1
strToFind = tbSearch.Text
Do
strToFind = tbSearch.Text
pos = InStr(1, strToSearch, strToFind)
For Y = 1 To Len(strToSearch)
Ask = MsgBox("Yes Next Occurrence or No To Exit ?", vbYesNo, "Question")
If Ask = vbYes Then
lbOne.AddItem pos
tbAns.Text = pos
If pos = 0 Then
Exit Sub
End If
rtbOne.SelStart = pos - 1
rtbOne.SelLength = Len(strToFind)
rtbOne.SelColor = vbRed
pos = InStr(pos + 1, strToSearch, strToFind)
Else
tbAns.Text = "NO"
pos = InStr(pos + 1, strToSearch, strToFind)
tbAns.Text = pos
Exit Sub
End If
Next
Loop Until pos > 0
End Sub
Private Sub Form_Load()
strToSearch = "This is a lot of text that will be loaded in the lbText and we will search it is it a case sensative Search"
rtbOne.Text = strToSearch
tbSearch.Text = "is"
End Sub
If this is not possible a few suggestions on how to use regex
I know this much I need to add the Reference and this might be the
Pattern myRegExp.Pattern = "(.)\strToFind\b(.)"

Answer 1

TOM FindText accepts the tomMatchWord flag. Just use that. Don't screw aroung extracting text out of the control and then munching on it using slow scripting language crutches like RegEx.

Answer 2

I was intrigued by the idea of a "built-in" search, as suggested by Bob77 and Mark, so I put together code to implement this idea. The code uses a WinAPI call but is really pretty simple overall and supports moving forward and backward along with toggles for case sensitivity and whole words:
Option Explicit
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Const WM_USER = &H400&
Private Const EM_GETOLEINTERFACE = (WM_USER + 60)
Private Enum Direction
Forward = 1
Backward = -1
End Enum
Private Doc As ITextDocument
Private Sub Form_Load()
RichTextBox1.HideSelection = False
RichTextBox1.Text = "is This is a lot of text that will be loaded in the lbText and we will " & _
"search it is it a case sensative Search" & vbCr & vbCr & _
"is and IS and is"
SearchTerm.Text = "is"
Dim Unknown As IUnknown
SendMessage RichTextBox1.hwnd, EM_GETOLEINTERFACE, 0&, Unknown
Set Doc = Unknown
End Sub
Private Sub cmdForward_Click()
Match SearchTerm.Text, chkWhole.Value, chkCase.Value, Forward
End Sub
Private Sub cmdBack_Click()
Match SearchTerm.Text, chkWhole.Value, chkCase.Value, Backward
End Sub
Private Sub Match(ByVal SearchTerm As String, ByVal WholeWords As Integer, ByVal CaseSensitive As Integer, ByVal Direction As Direction)
Dim Flags As Long
Flags = 2 * WholeWords + 4 * CaseSensitive
Doc.Selection.FindText SearchTerm, Direction * Doc.Selection.StoryLength, Flags
End Sub
You will need to add a reference to RICHED20.dll using the "Browse..." button in Project|References.

Answer 3

You might find following InStrAll implementation based on VBScript.RegExp useful.
Option Explicit
Private Sub Form_Load()
Const STR_TEXT As String = "This is a lot of text that will be loaded in the lbText and we will search it is it a case sensative Search"
Dim vElem As Variant
For Each vElem In InStrAll(STR_TEXT, "is")
Debug.Print vElem, Mid$(STR_TEXT, vElem, 2)
Next
End Sub
Public Function InStrAll(sText As String, sSearch As String, Optional ByVal Compare As VbCompareMethod = vbTextCompare) As Variant
Dim lIdx As Long
Dim vRetVal As Variant
With CreateObject("VBScript.RegExp")
.Global = True
.IgnoreCase = (Compare <> vbBinaryCompare)
.Pattern = "[.*+?^${}()/|[\]\\]"
.Pattern = "\b" & .Replace(sSearch, "\$&") & "\b"
With .Execute(sText)
If .Count = 0 Then
vRetVal = Array()
ElseIf .Count = 1 Then
vRetVal = Array(.Item(0).FirstIndex + 1)
Else
ReDim vRetVal(0 To .Count - 1) As Variant
For lIdx = 0 To .Count - 1
vRetVal(lIdx) = .Item(lIdx).FirstIndex + 1
Next
End If
End With
End With
InStrAll = vRetVal
End Function
The point is first you have to escape the searched string (prefix all regex control symbols with backslash) and then wrap this escaped pattern with \bs before performing the "global" search for all matches.
The InStrAll function returns an array of indexes in the original text. It's up to your to impl actual color-coded highlighting in the RichTextBox control of your choice. (I would set the background color, not the foreground of the found snippet, if I had a choice. Notice how most browsers use yellow background for search results highlighting.)

Answer 4

For a non-Regex approach, try the following:
Option Explicit
Private Sub Form_Load()
RichTextBox1.Text = "is This is a lot of text that will be loaded in the lbText and we will " & _
"search it is it a case sensative Search" & vbCr & vbCr & _
"is and is and is"
End Sub
Private Sub Command1_Click()
Dim SearchTerm As String
Dim SearchIndex As Integer
SearchTerm = "is"
SearchIndex = 1
Do
SearchIndex = InStr(SearchIndex, RichTextBox1.Text, SearchTerm)
If isMatch(SearchIndex, SearchTerm) Then
RichTextBox1.SelStart = SearchIndex - 1
RichTextBox1.SelLength = Len(SearchTerm)
RichTextBox1.SelColor = vbRed
End If
If SearchIndex > 0 Then SearchIndex = SearchIndex + Len(SearchTerm)
Loop Until SearchIndex = 0
End Sub
Private Function isMatch(ByVal SearchIndex As Long, ByVal SearchTerm As String) As Boolean
If SearchIndex = 1 Then
If Mid(RichTextBox1.Text, SearchIndex + Len(SearchTerm), 1) = " " Then isMatch = True
ElseIf SearchIndex + Len(SearchTerm) >= Len(RichTextBox1.Text) Then
If Mid(RichTextBox1.Text, SearchIndex - 1, 1) = " " Then isMatch = True
ElseIf SearchIndex > 1 Then
If (Mid(RichTextBox1.Text, SearchIndex - 1, 1) = " " Or Mid(RichTextBox1.Text, SearchIndex - 1, 1) = vbCr) And Mid(RichTextBox1.Text, SearchIndex + Len(SearchTerm), 1) = " " Then isMatch = True
End If
End Function
As noted in the comments, the original code had limitations. The code now supports matches at the beginning and end of the text, along with embedded breaks. You will likely need to add more checks to the isMatch method.