Visual Basic String Parsing to Provide a Keyword List

[Kaway]

[HIDE-THANKS]Procedure accepts a string and returns a string array contain the parsed words. The procedure filters out punctuation and words less than a specified length. The string array can then be passed to other procedures for processing.

Api.

>Option Explicit

Private Const CharList As String = " ,/.!@#$%^&*()?><';:+-=_[]{}|" & vbCrLf & vbTab & vbCr & vbLf & vbNewLine & vbBack

Private Const MIN_WORD_SIZE As Integer = 3  'Change this value to determine size of words to keep

Private Const TEST_STRING As String = "How many programmers does it take to screw in a lightbulb?"

cod.

>Private Function ParseString(ByVal vstrStringToParse As String) As String()
   'Function loops through the words in a string and places the words in an
   'array for manipulation - allows me to pass an array of keywords to another
   'function for processing.
   'Word must be greater than MIN_WORD_SIZE to be added to array
   'Uses helper function 'CleanWord' to remove punctuation
   
   Dim lstrKeywords()  As String
   Dim lintCurPos      As Integer
   Dim lintNextBreak   As Integer
   Dim lintArrCount    As Integer

   lintArrCount = 0
   lintCurPos = 1
   
   Do
       lintNextBreak = InStr(lintCurPos, vstrStringToParse, " ")
           
           If lintNextBreak = 0 Then
               If Len(Trim$(CleanWord(Mid$(vstrStringToParse, lintCurPos, Len(vstrStringToParse) - lintCurPos)))) > MIN_WORD_SIZE Then
                   ReDim Preserve lstrKeywords(lintArrCount)
                   lstrKeywords(lintArrCount) = CleanWord(Mid$(vstrStringToParse, lintCurPos, Len(vstrStringToParse) - lintCurPos))
               End If
               Exit Do
           Else
               If Len(Trim(CleanWord(Mid$(vstrStringToParse, lintCurPos, lintNextBreak - lintCurPos)))) > MIN_WORD_SIZE Then
                   ReDim Preserve lstrKeywords(lintArrCount)
                   lstrKeywords(lintArrCount) = Trim$(CleanWord(Mid$(vstrStringToParse, lintCurPos, lintNextBreak - lintCurPos)))
                   lintArrCount = lintArrCount + 1
               End If
           End If
       lintCurPos = lintNextBreak + 1
   Loop
   
   ParseString = lstrKeywords()

End Function

Private Function CleanWord(ByVal vstrWord As String) As String
   'Function removes punctuation values from the word and returns
   'only those values not included in the CharList constant
   
   Dim j           As Integer
   Dim oneChar     As String
   
   For j = 1 To Len(vstrWord)
       oneChar = Mid(vstrWord, j, 1)
       If (InStr(CharList, oneChar) = 0) Then
           CleanWord = CleanWord & oneChar
       End If
   Next j
   
End Function

'Demo Usage
Private Sub Form_Load()
   Text1.Text = TEST_STRING
End Sub

Private Sub Command1_Click()

   'Simple form with a TextBox, CommandButton, and a ComboBox
   Dim lstrParseArray() As String
   Dim lintCount As Integer

   lstrParseArray = ParseString(Trim$(Text1.Text))
   
   For lintCount = 0 To UBound(lstrParseArray)
       Combo1.AddItem lstrParseArray(lintCount)
   Next lintCount

   Combo1.ListIndex = 0
   
End Sub

[/HIDE-THANKS]