K
kheisler6
One project can have multiple consultants, and one consultant can be on
multiple projects. Therefore, I have a many-to-many. The junction table
is tblProjectsConsultants.
For any given project, the user is asked to enter all the consultants
on a continuous form.
I would like the user to enter a first and last name (separate fields),
and then have Access check for any records with the same name (i.e.,
warn him of a possible duplicate entry).
If one or more matching names are found, tell the user and show him a
list of matching records. (This list will include other more unique
fields (e.g., HireDate) that might help him determine if it's the
same person he's entering.) Then, give him the following options:
1. Select one of the matching records from the list and have that
record entered into the continuous form as a consultant.
2. If the user determines this is indeed a new consultant who just
happens to have the same name as an existing consultant, ignore the
list and let him add this new consultant to the project (and therefore,
to the underlying table as a new record).
I can handle option 2 with the following code, but I'm not sure how
to handle option 1. In other words, my current code just shows the user
a "hard" list of matching records with the option of ignoring it
and letting him add the new name/record, or canceling the entry. But
rather than just canceling the entry (to avoid a duplicate record), I
need to give him a way to select one of the matching records.
Any ideas? Thank you. (code below)
Kurt
##########
Dim sWhere As String
Dim bWarn As Boolean
Dim sMsg As String
Dim iLen As Integer
Dim db As Database
Dim rs As Recordset
Const SEP = "******************"
If IsNull(FName) Or IsNull(LName) Then
'Skip the test, all information not entered yet.
Else
'FistName field.
If IsNull(Me.FName) Then
bWarn = True
sMsg = "FName is blank" & vbCrLf
Else
sWhere = sWhere & "(FName = """ & Me.FName & """) AND "
End If
'LastName field.
If IsNull(Me.LName) Then
bWarn = True
sMsg = "LName is blank" & vbCrLf
Else
sWhere = sWhere & "(LName = """ & Me.LName & """) AND "
End If
If bWarn Then
sMsg = sMsg & vbCrLf & "Proceed anyway?"
If MsgBox(sMsg, vbYesNo + vbDefaultButton2) <> vbYes Then
Cancel = True
End If
End If
If Not Cancel Then
'Existing record is not a duplicate of itself.
If Not Me.NewRecord Then
sWhere = sWhere & "(ConsultantID <> " & Me.ConsultantID & ")
AND "
End If
iLen = Len(sWhere) - 5 'Without trailing " AND ".
If iLen > 0 Then
sWhere = Left$(sWhere, iLen)
sMsg = vbNullString
Set db = CurrentDb()
'Open a recordset of duplicates, and loop through them.
Set rs = db.OpenRecordset("SELECT ConsultantID, LName, FName,
HireDate, FROM tblConsultants WHERE (" & sWhere & ");")
With rs
If .RecordCount > 0 Then
Do While Not .EOF
sMsg = sMsg & SEP & vbCrLf & "Name: " & !FName & "
" & !LName & vbCrLf & "Hire Date: " & !HireDate & vbCrLf & vbCrLf
.MoveNext
Loop
'Ask the user if these are duplicates.
sMsg = "A consultant(s) by this name already exists. Please
confirm if any of these is the same consultant you are entering." &
vbCrLf & vbCrLf & Left(sMsg, Len(sMsg) - Len(SEP)) & vbCrLf & vbCrLf &
"Continue anyway?"
'sMsg = "Record:" & vbCrLf & Len(sMsg) - Len(SEP) & vbCrLf &
"Continue anyway?"
If MsgBox(sMsg, vbYesNo + vbDefaultButton2, "Possible Duplicate
") <> vbYes Then
Cancel = True
Me.Undo
End If
End If
End With
End If
End If
End If
Set rs = Nothing
Set db = Nothing
End Sub
multiple projects. Therefore, I have a many-to-many. The junction table
is tblProjectsConsultants.
For any given project, the user is asked to enter all the consultants
on a continuous form.
I would like the user to enter a first and last name (separate fields),
and then have Access check for any records with the same name (i.e.,
warn him of a possible duplicate entry).
If one or more matching names are found, tell the user and show him a
list of matching records. (This list will include other more unique
fields (e.g., HireDate) that might help him determine if it's the
same person he's entering.) Then, give him the following options:
1. Select one of the matching records from the list and have that
record entered into the continuous form as a consultant.
2. If the user determines this is indeed a new consultant who just
happens to have the same name as an existing consultant, ignore the
list and let him add this new consultant to the project (and therefore,
to the underlying table as a new record).
I can handle option 2 with the following code, but I'm not sure how
to handle option 1. In other words, my current code just shows the user
a "hard" list of matching records with the option of ignoring it
and letting him add the new name/record, or canceling the entry. But
rather than just canceling the entry (to avoid a duplicate record), I
need to give him a way to select one of the matching records.
Any ideas? Thank you. (code below)
Kurt
##########
Dim sWhere As String
Dim bWarn As Boolean
Dim sMsg As String
Dim iLen As Integer
Dim db As Database
Dim rs As Recordset
Const SEP = "******************"
If IsNull(FName) Or IsNull(LName) Then
'Skip the test, all information not entered yet.
Else
'FistName field.
If IsNull(Me.FName) Then
bWarn = True
sMsg = "FName is blank" & vbCrLf
Else
sWhere = sWhere & "(FName = """ & Me.FName & """) AND "
End If
'LastName field.
If IsNull(Me.LName) Then
bWarn = True
sMsg = "LName is blank" & vbCrLf
Else
sWhere = sWhere & "(LName = """ & Me.LName & """) AND "
End If
If bWarn Then
sMsg = sMsg & vbCrLf & "Proceed anyway?"
If MsgBox(sMsg, vbYesNo + vbDefaultButton2) <> vbYes Then
Cancel = True
End If
End If
If Not Cancel Then
'Existing record is not a duplicate of itself.
If Not Me.NewRecord Then
sWhere = sWhere & "(ConsultantID <> " & Me.ConsultantID & ")
AND "
End If
iLen = Len(sWhere) - 5 'Without trailing " AND ".
If iLen > 0 Then
sWhere = Left$(sWhere, iLen)
sMsg = vbNullString
Set db = CurrentDb()
'Open a recordset of duplicates, and loop through them.
Set rs = db.OpenRecordset("SELECT ConsultantID, LName, FName,
HireDate, FROM tblConsultants WHERE (" & sWhere & ");")
With rs
If .RecordCount > 0 Then
Do While Not .EOF
sMsg = sMsg & SEP & vbCrLf & "Name: " & !FName & "
" & !LName & vbCrLf & "Hire Date: " & !HireDate & vbCrLf & vbCrLf
.MoveNext
Loop
'Ask the user if these are duplicates.
sMsg = "A consultant(s) by this name already exists. Please
confirm if any of these is the same consultant you are entering." &
vbCrLf & vbCrLf & Left(sMsg, Len(sMsg) - Len(SEP)) & vbCrLf & vbCrLf &
"Continue anyway?"
'sMsg = "Record:" & vbCrLf & Len(sMsg) - Len(SEP) & vbCrLf &
"Continue anyway?"
If MsgBox(sMsg, vbYesNo + vbDefaultButton2, "Possible Duplicate
") <> vbYes Then
Cancel = True
Me.Undo
End If
End If
End With
End If
End If
End If
Set rs = Nothing
Set db = Nothing
End Sub