MS Access: Trying to create an error if there is a duplicate record but code flags everything

Viewed 67

I have a form that if a duplicate record is entered, the form creates an error message and prevents the record from being entered. However, my code is popping up the error message no matter what I'm putting in. My code is this...

Private Sub cmdSave_Click()
    ' ToDo fix the labels in this function so they match the function name. Just cosmetic.
On Error GoTo Add_CmdSave_Click_Err

  On Error Resume Next
     
   ' ToDo fix the labels in this function so they match the function name. Just cosmetic.
On Error GoTo Add_CmdSave_Click_Err

  On Error Resume Next
     
    Me.cbCompletedTrainingID = Me.IntermediateID
    
    
    '
    Dim OKToSave As Boolean
    OKToSave = True

    If Not SomethingIn(Me.[fIntermediate FacultyID]) Then          ' Null
        Beep
        MsgBox "A faculty member is required", vbOKOnly, "Missing Information"
        OKToSave = False
    End If
    If Not SomethingIn(Me.[fIntermediate TrainingID]) Then
        Beep
        MsgBox "A training is required", vbOKOnly, "Missing Information"
        OKToSave = False
    Else
    
    Dim rs As Object

    Set rs = Me.Recordset.Clone
    rs.FindFirst "[IntermediateID] = " & Me.[fIntermediate FacultyID] And Me.[fIntermediate TrainingID]
    If Not rs.EOF Then
        Beep
        MsgBox "This person has already completed this training", vbOKOnly, "Duplicate Training Completion"
        OKToSave = False
    End If

       
    End If
    If OKToSave Then
        ' If we get this far, all data is valid and it's time to save
        Me.Dirty = False
        DoCmd.GoToRecord , "", acNewRec
        
       
    End If
      
Add_CmdSave_Click_Exit:
    Exit Sub

Add_CmdSave_Click_Err:
    
    Resume Add_CmdSave_Click_Exit


End Sub

The issue, from my standpoint, lies in this part...

Dim rs As Object
    
        Set rs = Me.Recordset.Clone
        rs.FindFirst "[IntermediateID] = " & Me.[fIntermediate FacultyID] And Me.[fIntermediate TrainingID]
        If Not rs.EOF Then
            Beep
            MsgBox "This person has already completed this training", vbOKOnly, "Duplicate Training Completion"
            OKToSave = False
        End If

What am I doing wrong?

2 Answers

Have a look at How to debug dynamic SQL in VBA.

This line makes no sense as it is:

rs.FindFirst "[IntermediateID] = " & Me.[fIntermediate FacultyID] And Me.[fIntermediate TrainingID]

You probably want something like

S = "[IntermediateID] = " & Me.[fIntermediate FacultyID] & " And [TrainingID] = " & Me.[fIntermediate TrainingID]
Debug.Print S    ' Ctrl+G shows the output
rs.FindFirst S

Also, remove all these On Error Resume Next - this will happily ignore any errors, making debugging nearly impossible.

Also useful: Debugging VBA Code

And there is more: If Recordset.FindFirst doesn't find a match, it doesn't trigger .EOF. It sets the .NoMatch property.

rs.FindFirst S
If rs.NoMatch Then
    ' all is good, proceed to save
Else
    ' record exists
End If

This should work as intended:

Dim rs          As DAO.Recordset

Dim Criteria    As String
    
Set rs = Me.RecordsetClone

Criteria = "[IntermediateID] = " & Me![fIntermediate FacultyID].Value & " And [TrainingID] = " & Me![fIntermediate TrainingID].Value & ""

Debug.Print OKToSave, Criteria

rs.FindFirst Criteria
If Not rs.NoMatch Then
    Beep
    MsgBox "This person has already completed this training", vbInformation + vbOKOnly, "Duplicate Training Completion"
    OKToSave = False
End If
rs.Close

Debug.Print OKToSave
Related