Well then,
When I coded it, I split it into two Functions:
IsVowel() - You pass in a single character and the function returns True if it's a vowel or false if it's not.
Code:
Public Function IsVowel(Character As String) As Boolean
' This function checks the passed argument to see if it is a vowel or not. If
' it is a vowel, the function returns True. If not (or if more than one
' character is passed), it returns False.
' Arguments:
' Character - a string containing the character to check. If more than a
' single character is passed, the function returns False.
' Make sure the passed argument is only a single character
If Len(Character) = 1 Then
' Is the character a vowel
If LCase(Character) = "a" Or LCase(Character) = "e" Or LCase(Character) = "i" Or LCase(Character) = "o" Or LCase(Character) = "u" Then
' If it is
IsVowel = True ' Return True
Else
' If it's not
IsVowel = False ' Return False
End If
Else
' If it's more than one char
IsVowel = False ' Return False
End If
End Function
CustomSplit() - Reads a collection of words from the database and, using IsVowel(), splits them into groupings of consecutive vowels and consonants.
Code:
Public Sub CustomSplit()
' This function looks at the words listed in the input Table 'MyTable' and,
' one at a time, splits them into groupings of consecutive consonants and
' vowels. These groupings are then saved into the output Table 'Output'.
' Arguments:
' NONE
' Use DAO Recordsets to connect to a Table in the DB
Dim db1 As DAO.Database
Dim rstInput As DAO.Recordset
Dim rstOutput As DAO.Recordset
Dim i As Long
Dim nbrSegment As Long
Dim nbrWordLen As Long
Dim strLastChar As String
Dim strWordText As String
Set db1 = CurrentDb()
Set rstInput = db1.OpenRecordset("MyTable", dbOpenSnapshot) ' The input Table, read-only
Set rstOutput = db1.OpenRecordset("Output", dbOpenDynaset) ' The output Table, writeable
' If the output Table has anything in it, empty it out. This will prevent
' duplicate entries if the function is run multiple times
If Not rstOutput.RecordCount = 0 Then
Do While Not rstOutput.EOF
With rstOutput
.Delete
End With
rstOutput.MoveNext
Loop
End If
' Are there any words saved into the input Table?
If rstInput.RecordCount = 0 Then
' If not, alert the user
MsgBox "No words to split!"
Else
' If so, continue processing
' Loop through each word in the input Table and process them one at a time
Do While Not rstInput.EOF
' When starting a (new) word, reset our variables
nbrSegment = 1
nbrWordLen = Len(rstInput("WordText")) ' Figure out how long the word is
strLastChar = Mid(rstInput("WordText"), 1, 1) ' Set to the first letter of the word, forcint the first comparison to match
strWordText = "" ' Make sure our string for the consecutive block of vowels or consonants is empty
' Perform the following comparison for each letter in the word
For i = 1 To nbrWordLen Step 1
' Does the "vowel status" of the previous letter in the word match the
' "vowel status" of the current letter? Note: We don't care if the
' letters are vowels or not, only that they are either BOTH vowels or
' NEITHER OF THEM are vowels
If IsVowel(strLastChar) = IsVowel(Mid(rstInput("WordText"), i, 1)) Then
' If they both have the same "vowel status"
strLastChar = Mid(rstInput("WordText"), i, 1) ' Save the current letter so we can compare it against the next letter in the word
strWordText = strWordText & strLastChar ' Add the current letter to our string of consecutive letters
Else
' If the two letters don't match
' Write our current string of consecutive letters to the output Table
With rstOutput
.AddNew
!WordTextID = rstInput("WordTextID")
!SerialNumber = nbrSegment
!TheWordTextPart = strWordText
.Update
End With
' Increment/Reset our variables
nbrSegment = nbrSegment + 1 ' Increment our segment counter
strLastChar = Mid(rstInput("WordText"), i, 1) ' Save the current letter for comparison
strWordText = strLastChar ' Save the current letter to the string of consecutive letters (replacing the old string, not adding to the end)
End If
Next i
' If we're done with the word, write our current (last) set of
' consecutive letters to the output Table
If Len(strWordText) > 0 Then
With rstOutput
.AddNew
!WordTextID = rstInput("WordTextID")
!SerialNumber = nbrSegment
!TheWordTextPart = strWordText
.Update
End With
End If
' Start on the next word
rstInput.MoveNext
Loop
End If
End Sub
Windows 2K 
Access 2000
Reply With Quote
Originally Posted by Rawb
