|
| |
|
Warn About Possible Duplicates |
| Here is some code
that will warn you that you are entering duplicates names in a table. You
can then accept or reject the duplicate name:
Private Sub LastName_AfterUpdate()
Dim db As Database ' Currentdb()
Dim sSQL As String ' SQL string
Dim lngDupes As Long ' Count possible duplicates
Dim sOut As String ' MsgBox string
Const conMaxDupes = 18 ' Maxiumum number of duplicates to report.
If Not (IsNull(Me!LastName) Or IsNull(Me!Firstname)) Then
' Select all the records matching LastName and FirstName, excluding
the current record:
'SQL = "SELECT contactid, FirstName, lastname, company, Address1,
city FROM allcontacts WHERE (lastname = """ & Me!LastName & """) AND
(FirstName= """ & Me!Firstname & """) AND (contactid <> " &
Me!ContactID & ");"
' Or, if you prefer, select all the records matching LastName and
the first letter of the FirstName, excluding the current record
(you'll have to choose one of them)
sSQL = "SELECT contactid, FirstName, lastname, company, Address1,
city FROM allcontacts WHERE (lastname = """ & Me!LastName & """) AND
(left(FirstName,1)= """ & Left(Me!Firstname, 1) & """) AND (contactid
<> " & Me!ContactID & ");"
Set db = CurrentDb()
Set rst = db.OpenRecordset(sSQL)
With rst
' Loop through the records, creating a string of names and addresses
Do While Not .EOF
'sOut = sOut & " " & !LastName & ", " & !Firstname & " of " &
IIf([Company] Is Null, "", !Company & ", ") & !Address1 & ", " &
StrConv(!City, vbProperCase) & vbCrLf
sOut = sOut & " " & !LastName & ", " & !Firstname & ", " & !Company
& ", " & !Address1 & ", " & StrConv(!City, vbProperCase) & vbCrLf
.MoveNext
lngDupes = lngDupes + 1
If lngDupes > conMaxDupes And Not .EOF Then
sOut = sOut & " and others." & vbCrLf
Exit Do
End If
Loop
End With
rst.Close
End If
' If we found possible duplicates, ask the user what to do.
If lngDupes > 0 Then
sOut = "POSSIBLE DUPLICATE" & IIf(lngDupes = 1, ":", "S:") & vbCrLf
& sOut & vbCrLf & vbCrLf & "Continue anyway?"
If MsgBox(sOut, vbQuestion + vbYesNo + vbDefaultButton2, "Are you
sure?") <> vbYes Then Cancel = True
End If
End Sub
|
|
|