by Stephen Skaggs (1 Submission)
Category: String Manipulation
Compatability: Visual Basic 5.0
Difficulty: Unknown Difficulty
Originally Published: Thu 5th October 2000
Date Added: Mon 8th February 2021
Rating: 
(1 Votes)
Generate an Oracle-compliant SoundEx() string
VBcoders
Private Function SoundEx(ByVal WordString As String, Optional SoundExLen As Integer = 4) As String
Dim Counter As Integer
Dim CurrChar As String
If SoundExLen > 10 Then
SoundExLen = 10
ElseIf SoundExLen < 4 Then
SoundExLen = 4
End If
SoundExLen = SoundExLen - 1
WordString = UCase(WordString)
For Counter = 1 To Len(WordString)
If Asc(Mid(WordString, Counter, 1)) < 65 Or Asc(Mid(WordString, Counter, 1)) > 90 Then
Mid(WordString, Counter, 1) = " "
End If
Next Counter
WordString = Trim(WordString)
SoundEx = WordString
SoundEx = Replace(SoundEx, "A", "0")
SoundEx = Replace(SoundEx, "E", "0")
SoundEx = Replace(SoundEx, "I", "0")
SoundEx = Replace(SoundEx, "O", "0")
SoundEx = Replace(SoundEx, "U", "0")
SoundEx = Replace(SoundEx, "Y", "0")
SoundEx = Replace(SoundEx, "H", "0")
SoundEx = Replace(SoundEx, "W", "0")
SoundEx = Replace(SoundEx, "B", "1")
SoundEx = Replace(SoundEx, "P", "1")
SoundEx = Replace(SoundEx, "F", "1")
SoundEx = Replace(SoundEx, "V", "1")
SoundEx = Replace(SoundEx, "C", "2")
SoundEx = Replace(SoundEx, "S", "2")
SoundEx = Replace(SoundEx, "G", "2")
SoundEx = Replace(SoundEx, "J", "2")
SoundEx = Replace(SoundEx, "K", "2")
SoundEx = Replace(SoundEx, "Q", "2")
SoundEx = Replace(SoundEx, "X", "2")
SoundEx = Replace(SoundEx, "Z", "2")
SoundEx = Replace(SoundEx, "D", "3")
SoundEx = Replace(SoundEx, "T", "3")
SoundEx = Replace(SoundEx, "L", "4")
SoundEx = Replace(SoundEx, "M", "5")
SoundEx = Replace(SoundEx, "N", "5")
SoundEx = Replace(SoundEx, "R", "6")
CurrChar = Left(SoundEx, 1)
For Counter = 2 To Len(SoundEx)
If Mid(SoundEx, Counter, 1) = CurrChar Then
Mid(SoundEx, Counter, 1) = " "
Else
CurrChar = Mid(SoundEx, Counter, 1)
End If
Next Counter
SoundEx = Replace(SoundEx, " ", "")
SoundEx = Mid(SoundEx, 2)
SoundEx = Replace(SoundEx, "0", "")
SoundEx = SoundEx & String(SoundExLen, "0")
SoundEx = Left(WordString, 1) & Left(SoundEx, SoundExLen)
End Function
