Solved

How to find word in VB?

Posted on 2003-11-03
13
232 Views
Last Modified: 2010-05-01
Hi friends,
I want to find a certain word in an code fragment by identifying an format, for example, I want to find endex of all words which is between two single-quotes.

for sentence :'test' for 'some words'

for above example, I want find index of words "test", "some" and "words"
Please help me.
0
Comment
Question by:VTV
  • 5
  • 4
  • 3
  • +1
13 Comments
 

Expert Comment

by:oxygen_728
Comment Utility
Ok here's how i would do it.

I am assuming you want to find all occurances of words between ' '  

I have a string tokenizer i made for VB .. it is written in VB.net and will work with other versions but you will have to change some syntax.

1. Make a button on a form.

2. Double click on that button.

3. Insert code:  

  dim stoke, stoke2 as new Stoken()
  fileopen(2, "YourFile.txt", OpenMode.Input)
  dim Textline, Token as string
  dim count1 as integer

 While not EOF(2)
  textline = LineInput(2)
  Stoke.load(textline, " '")
  count1 = 1
  while stoke.gettokens(count1) <> ""
    stoke2.load(stoke(gettokens(count1), "' ")
    msgbox(stoke2.gettokens(1))  ' Change this line to do whatever you want with the words -- This word is in between 's
  count1 += 1
  end while
end while


'------------------------------------------------------------------------------------------

If you are extremely picky and do not want any 's in your final result, add a 3rd stoken -- or reuse your second one, to tokenize with a ' in the second argument.

If you aren't good at code, perhaps you wont understand this, but i'm proud of my little tokenizer =) (since i couldn't find one in vb)


Here's the String Tokenizer

Public Class Stoken
  ' Made by Brian Webster oxygen@upperspace.com
  ' Updated October 2003
  ' String Tokenizer
  ' Tokens are stored in tokens(), maximum size 50

  Dim str1 As String
  Dim total As Integer
  Dim tokens(50) As String


  Public Function load(ByVal str As String, ByVal strdiv1 As String)


    str1 = str
    'MsgBox str1
    Dim counter1, counter2, counter3 As Integer
    Dim StrPart As String
    Dim StrDiv As String
    counter1 = 1
    counter3 = 0
    StrDiv = strdiv1

    Dim DivStarts(50) As Integer
    For counter1 = 0 To 49
      DivStarts(counter1) = 0
    Next
    counter1 = 1

    StrPart = Mid$(str1, counter1, StrDiv.Length)
    While counter1 <= str1.Length
      If StrPart = StrDiv Then
        DivStarts(counter3) = counter1
        counter3 += 1
        counter1 += StrDiv.Length - 1
      End If

      counter1 += 1
      StrPart = Mid$(str1, counter1, StrDiv.Length)
    End While

    total = 0
    counter1 = 1
    counter3 = 1
    Dim tokencounter As Integer = 1

    If DivStarts(0) > 1 Then
      tokens(tokencounter) = Mid$(str1, 1, DivStarts(0) - 1)
      tokencounter += 1
      total += 1
    End If

    While DivStarts(counter1) <> 0
      tokens(tokencounter) = Mid$(str1, DivStarts(counter1 - 1) + StrDiv.Length, DivStarts(counter1) - DivStarts(counter1 - 1) - StrDiv.Length)
      tokencounter += 1
      total += 1
      counter1 += 1
    End While

    If DivStarts(counter1 - 1) <> 0 And DivStarts(counter1 - 1) + StrDiv.Length - 1 <> str1.Length Then
      tokens(tokencounter) = Mid$(str1, DivStarts(counter1 - 1) + StrDiv.Length, str1.Length)
      total += 1
    End If

    If DivStarts(0) = 0 And str1 <> "" Then
      tokens(1) = str1
      total += 1
    End If
  End Function

  Public Function GetTotal() As Integer
    GetTotal = total
  End Function

  Public Function ShaveTokens()

    Dim counter1 As Integer
    Dim counter2 As Integer
    Dim StrPart As String

    counter1 = 1
    counter2 = 1

    Do While counter1 <= total
      counter2 = 1

      Do While counter2 <= tokens(counter1).Length

        If Mid$(tokens(counter1), counter2, 1) = " " Then

          tokens(counter1) = Left$(tokens(counter1), counter2 - 1) & Mid$(tokens(counter1), counter2 + 1)
          counter2 = counter2 - 1
        End If

        counter2 = counter2 + 1
      Loop

      counter1 = counter1 + 1
    Loop

  End Function

  Public Function GetToken(ByVal x As Integer) As String

    GetToken = tokens(x)

  End Function
End Class
0
 

Expert Comment

by:oxygen_728
Comment Utility
BTW, i don't know how to do what you are wanting to do in the Visual Studio developing environment.

In many situations, I am forced to make a button and perform actions myself.



P.S. -- My code above assumes that you will save your code to a textfile in the bin folder of your application called yourfile.txt

0
 
LVL 3

Expert Comment

by:monvelasquez
Comment Utility
' You need to add Microsoft VBScript Regular Expressions 5.5 in
' your project references.

Dim re As New RegExp
Dim re2 As New RegExp
Dim QuotedPhrase As Match
Dim QuotedPhrases As MatchCollection
Dim Word As Match
Dim Words As MatchCollection
Dim Sentence As String
             
  '           123456789012345678901234567890
  Sentence = "'test' for 'some words'"

  'This Regular Expression will be used to find phrases enclosed in quotes
  re.Global = True
  re.IgnoreCase = True
  re.Pattern = "(')([^']*)(')"
  ' The pattern above can be dissected as follows
  ' (')      - Match the opening quote
  ' ([^']*)  - Match a phrase, a string of any characters
  ' (')      - Match the ending quote
 
  'This Regular Expression will be used to find words within the phrases
  re2.Global = True
  re2.IgnoreCase = True
  re2.Pattern = "(\S+)(\s+)"
  ' The pattern above can be dissected as follows
  ' (\S+)    - Match a word, any non-whitespace character
  ' (\s+)     - Match a series whitespace characters
 
 
  Set QuotedPhrases = re.Execute(Sentence)  ' Find the phrases
  If QuotedPhrases.Count > 0 Then           ' if found...
    For Each QuotedPhrase In QuotedPhrases  ' ...loop through the phrases
     
      ' Find the words whitin the phrases
      Set Words = re2.Execute(QuotedPhrase.SubMatches(1) & " ")
      If Words.Count > 0 Then   ' If Found...
        For Each Word In Words  ' ... loop through the words
         
          ' The index returned by the Matches are zero-based.
          ' The reason for the "+ 2" is to compensate for the 1-based index of
          ' VB strings plus the opening quote
          Debug.Print _
            Word.SubMatches(0); _
            " found at "; _
            QuotedPhrase.FirstIndex + 2 + Word.FirstIndex
         
        Next
      Else
        Debug.Print _
            QuotedPhrase.SubMatches(1); _
            " found at "; _
            QuotedPhrase.FirstIndex + 2
      End If
   
    Next 'QuotedPhrase
  Else 'If QuotedPhrases.Count > 0
    Debug.Print "No match found."
  End If
 
Set re = Nothing
Set re2 = Nothing
0
 

Expert Comment

by:oxygen_728
Comment Utility
Very interesting and useful Monvel.

I'll have to keep that in my head!

My my, I may actually put something to use that i learned in college =)
0
 

Author Comment

by:VTV
Comment Utility
I haven't ever written class in VB, but when I copy your code into my project, many error syntax show up. I am developing on Microsoft Visual Studio 6.0 environment
0
 

Expert Comment

by:oxygen_728
Comment Utility
' You need to add Microsoft VBScript Regular Expressions 5.5 in
' your project references.

Make sure you do this.

& make sure you give him the credit =)

0
Enabling OSINT in Activity Based Intelligence

Activity based intelligence (ABI) requires access to all available sources of data. Recorded Future allows analysts to observe structured data on the open, deep, and dark web.

 

Author Comment

by:VTV
Comment Utility
I will try this, anyway thanks all. I will inform you when I finish.
0
 

Author Comment

by:VTV
Comment Utility
I am running your code, monvelasquez but error show up "Method or data name member not found" at line Set Words = re2.Execute(QuotedPhrase.SubMatches(1) & " ") at function "SubMatches"
I also include Microsoft VBScript Regular Expressions as you said but I don't know what version it is because there is only one
Please help me to fix this error
Thanks
0
 
LVL 3

Expert Comment

by:monvelasquez
Comment Utility
I think you have version 1.0

Update the following lines..
-----------------------------------------------------------------------------------
CHANGE
Set Words = re2.Execute(QuotedPhrase.SubMatches(1) & " ")
TO
Set Words = re2.Execute(Replace(QuotedPhrase.Value, "'", "") & " ")
-----------------------------------------------------------------------------------
CHANGE
          Debug.Print _
            Word.SubMatches(0); _
            " found at "; _
            QuotedPhrase.FirstIndex + 2 + Word.FirstIndex
TO
          Debug.Print _
            Trim(Word.Value); _
            " found at "; _
            QuotedPhrase.FirstIndex + 2 + Word.FirstIndex
-----------------------------------------------------------------------------------
CHANGE
        Debug.Print _
            QuotedPhrase.SubMatches(1); _
            " found at "; _
            QuotedPhrase.FirstIndex + 2
TO
        Debug.Print _
            Replace(QuotedPhrase.Value, "'", ""); _
            " found at "; _
            QuotedPhrase.FirstIndex + 2
-----------------------------------------------------------------------------------
That should work...

___________
Raymond:\>_
0
 
LVL 76

Expert Comment

by:GrahamSkan
Comment Utility
You could use the Find method of a RichTextBox.
This code will return an array of zero-based offsets for a given word (FindString)

Public Function FindWord(rtbMine As RichTextBox, FindString As String)
    Dim idx As Long
    Dim Indices() As Long
    Dim Count As Integer
    idx = rtbMine.Find(FindString, idx, , rtfMatchCase + rtfWholeWord)
    Do Until idx = -1
        ReDim Preserve Indices(Count)
        Indices(Count) = idx
        Count = Count + 1
        idx = idx + Len(FindString)
        idx = rtbMine.Find(FindString, idx, , rtfMatchCase + rtfWholeWord)
    Loop
    FindWord = Indices()
End Function
0
 

Author Comment

by:VTV
Comment Utility
Hi monvelasquez
your program find index of characters, not word.
With "'test' for 'some words'", it give result "0 0", "11 0", "11 5" while I nedd it gives 1, 3, 4 are index of "test", "some" and "words"
Can you solve problem?
0
 
LVL 3

Accepted Solution

by:
monvelasquez earned 45 total points
Comment Utility
well then add another function..
'------------------------------------------------------------------------------------------
Function CountWords(ByVal Sentence As String) As Long
  Dim arrWords As Variant
  arrWords = Split(Sentence, " ")
  CountWords = UBound(arrWords) + 1
End Function
'------------------------------------------------------------------------------------------

Then modify the following parts of the code
'------------------------------------------------------------------------------------------
CHANGE
          Debug.Print _
            Trim(Word.Value); _
            " found at "; _
            QuotedPhrase.FirstIndex + 2 + Word.FirstIndex
TO
          Debug.Print _
            Trim(Word.Value); _
            " found at "; _
            CountWords(Left(Sentence, QuotedPhrase.FirstIndex + 2 + Word.FirstIndex))
'------------------------------------------------------------------------------------------
CHANGE
        Debug.Print _
            Replace(QuotedPhrase.Value, "'", ""); _
            " found at "; _
            QuotedPhrase.FirstIndex + 2
TO
        Debug.Print _
            Replace(QuotedPhrase.Value, "'", ""); _
            " found at "; _
            CountWords(Left(Sentence, QuotedPhrase.FirstIndex + 2))
'------------------------------------------------------------------------------------------

I sure hope this would do it..

____________
Raymond:\>_
0
 

Author Comment

by:VTV
Comment Utility
Thanks, Monvelaquez.
It works well
0

Featured Post

How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

Join & Write a Comment

When trying to find the cause of a problem in VBA or VB6 it's often valuable to know what procedures were executed prior to the error. You can use the Call Stack for that but it is often inadequate because it may show procedures you aren't intereste…
Background What I'm presenting in this article is the result of 2 conditions in my work area: We have a SQL Server production environment but no development or test environment; andWe have an MS Access front end using tables in SQL Server but we a…
As developers, we are not limited to the functions provided by the VBA language. In addition, we can call the functions that are part of the Windows operating system. These functions are part of the Windows API (Application Programming Interface). U…
Get people started with the utilization of class modules. Class modules can be a powerful tool in Microsoft Access. They allow you to create self-contained objects that encapsulate functionality. They can easily hide the complexity of a process from…

771 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

11 Experts available now in Live!

Get 1:1 Help Now