Calling soundex function is SQL 1

[MikeGeitner]

Hello,

I've been playing around with a soundex function that I found in this forum that compares the last name in a textbox with those in a table.
So, in the BeforeUpdate event I put the following, but I get "Error 3464 - Data mismatch in criteria expression".

Any help is appreciated, as always.

Private Sub Form_BeforeUpdate(Cancel As Integer)

Dim rst As DAO.Recordset, strNames As String

 ' If on a new row,
 If (Me.NewRecord = True) Then
   ' Check for similar name
   If Trim(Me.txtLast & "") <> "" Then
   
    
     ' Open a recordset to look for similar names
     Set rst = DBEngine(0)(0).OpenRecordset( _
       "SELECT Last, First FROM " & _
       "tblClients WHERE SoundsLike([Last]) = '" & _
       SoundsLike(Me.txtLast) & "'")
      
'Plain test SQL - This works
'       Set rst = DBEngine(0)(0).OpenRecordset("SELECT Last, First FROM " & _
'"tblClients WHERE([Last])= '" & (Me.txtLast) & "'")
       
       
       
     ' If got some similar names, issue warning message
     Do Until rst.EOF
       strNames = strNames & rst!Last & ", " & rst!First & vbCrLf
       rst.MoveNext
     Loop
     ' Done with the recordset
     rst.Close
     Set rst = Nothing
     ' See if we got some similar names
     If Len(strNames) > 0 Then
       ' Yup, issue warning
       If vbNo = MsgBox(" found members with similar " & _
         "last names already saved in the database: " & _
         vbCrLf & vbCrLf & strNames & _
         vbCrLf & "Are you sure this member is not a duplicate?", _
         vbQuestion + vbYesNo + vbDefaultButton2) Then
         ' Cancel the save
         Cancel = True
       End If
     End If
   End If
 End If
 ' Additional code not related to this example ...

End Sub

The Function:

Public Function SoundsLike(ByVal pWord As String, Optional pAccuracy As Byte = 4) As String
  On Error GoTo LocalError
  '  char importance "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
  Dim x As Integer
  Dim CChar As String

  If pAccuracy > 10 Then
    pAccuracy = 10                     ' maximum accuracy allowed
  ElseIf pAccuracy < 4 Then
    pAccuracy = 4                      ' minimum accuracy allowed
  End If
  ' account for the first character
  pAccuracy = pAccuracy - 1

  pWord = UCase(pWord)

  ' strip all invalid characters
  For x = 1 To Len(pWord)
    If Asc(Mid(pWord, x, 1)) < 65 Or _
        Asc(Mid(pWord, x, 1)) > 90 Then
      Mid(pWord, x, 1) = "@"           ' assign a catchable value
    End If
  Next x
  pWord = Trim(pWord)

  SoundsLike = pWord
  ' assign values to the string
  SoundsLike = Replace(SoundsLike, "A", "0")
  SoundsLike = Replace(SoundsLike, "E", "0")
  SoundsLike = Replace(SoundsLike, "I", "0")
  SoundsLike = Replace(SoundsLike, "O", "0")
  SoundsLike = Replace(SoundsLike, "U", "0")
  SoundsLike = Replace(SoundsLike, "Y", "0")
  SoundsLike = Replace(SoundsLike, "H", "0")
  SoundsLike = Replace(SoundsLike, "W", "0")
  SoundsLike = Replace(SoundsLike, "B", "1")
  SoundsLike = Replace(SoundsLike, "P", "1")
  SoundsLike = Replace(SoundsLike, "F", "1")
  SoundsLike = Replace(SoundsLike, "V", "1")
  SoundsLike = Replace(SoundsLike, "C", "2")
  SoundsLike = Replace(SoundsLike, "S", "2")
  SoundsLike = Replace(SoundsLike, "G", "2")
  SoundsLike = Replace(SoundsLike, "J", "2")
  SoundsLike = Replace(SoundsLike, "K", "2")
  SoundsLike = Replace(SoundsLike, "Q", "2")
  SoundsLike = Replace(SoundsLike, "X", "2")
  SoundsLike = Replace(SoundsLike, "Z", "2")
  SoundsLike = Replace(SoundsLike, "D", "3")
  SoundsLike = Replace(SoundsLike, "T", "3")
  SoundsLike = Replace(SoundsLike, "L", "4")
  SoundsLike = Replace(SoundsLike, "M", "5")
  SoundsLike = Replace(SoundsLike, "N", "5")
  SoundsLike = Replace(SoundsLike, "R", "6")

  CChar = Left(SoundsLike, 1)
  For x = 2 To Len(SoundsLike)
    If Mid(SoundsLike, x, 1) = CChar Then
      Mid(SoundsLike, x, 1) = "@"
    Else
      CChar = Mid(SoundsLike, x, 1)
    End If
  Next x
  SoundsLike = Replace(SoundsLike, "@", "")

  SoundsLike = Mid(SoundsLike, 2)
  SoundsLike = Replace(SoundsLike, "0", "")

  SoundsLike = SoundsLike & String(pAccuracy, "0")
  SoundsLike = Left(pWord, 1) & Left(SoundsLike, pAccuracy)
  Exit Function
LocalError:
End Function

 

[Remou]

There is a function available from Microsoft:

http://msdn2.microsoft.com/en-us/library/aa662178.aspx

Then:
The where statement excludes the current record:

strNames = CheckSoundex("tblCompanies", "Company", Me.txtCompany, _
" AND CompanyKey<>" & Me.txtCompanyKey)

In your example you will probably need to use the text property: Me.txtCompanyKey.Text, because you will run into problems with empty or null strings.


This function builds a list of "soundex" names:

Function CheckSoundex(TableName As String, FieldName As String, _
        ComparisonText As String, _
        Optional ExcludeKeyStatement As String = "") As String
Dim RS As DAO.Recordset
Dim db As Database
Dim strNames As String
Dim strSQL As String

On Error GoTo HErr

    Set db = CurrentDb
    CheckSoundex = ""
    
    'Watch out for null and empty strings ie <>''
    strSQL = "SELECT " & FieldName & " FROM " & _
        TableName & " WHERE Trim([" & FieldName & "] & '') <>'' " _
        & "AND Soundex([" & FieldName & "]) = '" & _
        Soundex(ComparisonText) & "' " & ExcludeKeyStatement
    
    Set RS = db.OpenRecordset(strSQL)
      
    ' If similar names, issue warning message
    Do Until RS.EOF
      strNames = strNames & RS(FieldName) & vbCrLf
      RS.MoveNext
    Loop
    
    ' Done with the recordset
    RS.Close
    Set RS = Nothing
    
    ' See if we got some similar names
    If Len(strNames) > 0 Then
        ' Issue warning (500 is arbitrary number) 
        If Len(Trim(strNames)) > 500 Then
            strNames = Left(strNames, 500) & " ... "
        End If
    End If
    
    CheckSoundex = strNames

Exit_Proc:
    Set db = Nothing
    Exit Function

HErr:
    HandleErr Err.Number, Err.Description
    Resume Exit_Proc
End Function

 

[MikeGeitner]

Remou,

Thanks for the help. The table had a couple of last name fields that were empty. That was causing the trouble, like you said it would. I filled them in and now it works.

Cheers,

Mike