On the OnClick event of a command button I have code that copies a parent record and all of its child records in the same table using recordsets:
This code works fine except when there's a duplicate record. I try to handle this in Error_Handler. If the user is trying to copy a record that already exists with the same MatricId, CodeDiscTypeId, and CodeDiscId, then I basically want to skip over that record and move on to the next record in the rstDiscFrom recordset. This appears to work for the first record in the recordset. However, come the second duplicate record, the code stops at the .Update line above where it tries to add a new record to rstDiscTo (and where I put a CODE STOPS comment for you) and it gives me a Run-Time Error 3022. I want it to jump to my Error_Handler so it knows to just skip that record and move on to the next. How do I do this?
Code:
Private Sub cmdCopy_Click()
On Error GoTo Error_Handler
Dim lngMatricIdFrom As Long
Dim lngMatricIdTo As Long
Dim lngDiscId As Long
Dim lngDiscClassId As Long
Dim lngNewDiscId As Long
Dim lngNewDiscClassId As Long
Dim strStatus As String
Dim rstDiscTo As DAO.Recordset
Dim rstDiscFrom As DAO.Recordset
Dim rstDiscClTo As DAO.Recordset
Dim rstDiscClFrom As DAO.Recordset
Dim rstDiscCrTo As DAO.Recordset
Dim rstDiscCrFrom As DAO.Recordset
Dim rstDiscCrExTo As DAO.Recordset
Dim rstDiscCrExFrom As DAO.Recordset
DoCmd.Hourglass True
strStatus = SysCmd(acSysCmdSetStatus, "Copying Disciplines...")
lngMatricIdFrom = Me.cboMatricIdFrom.Column(0)
lngMatricIdTo = Me.cboMatricIdTo.Column(0)
Set rstDiscTo = CurrentDb.OpenRecordset("Disc", dbOpenDynaset)
Set rstDiscFrom = CurrentDb.OpenRecordset("SELECT * FROM Disc WHERE MatricId = " & lngMatricIdFrom)
If rstDiscFrom.BOF And rstDiscFrom.EOF Then
GoTo Exit_Procedure
Else: rstDiscFrom.MoveFirst
End If
'Copy discipline with selected matricid
Do While Not rstDiscFrom.EOF
With rstDiscTo
.AddNew
!MatricId = lngMatricIdTo
!CodeDiscTypeId = rstDiscFrom!CodeDiscTypeId
!CodeDiscId = rstDiscFrom!CodeDiscId
!CreditMin = rstDiscFrom!CreditMin
!CourseMin = rstDiscFrom!CourseMin
!ClassMin = rstDiscFrom!ClassMin
!SortOrder = rstDiscFrom!SortOrder
.Update 'CODE STOPS
.Bookmark = rstDiscTo.LastModified
lngNewDiscId = rstDiscTo!DiscId
End With
lngDiscId = rstDiscFrom!DiscId
Set rstDiscClTo = CurrentDb.OpenRecordset("DiscClass", dbOpenDynaset)
Set rstDiscClFrom = CurrentDb.OpenRecordset("SELECT * FROM DiscClass WHERE DiscId = " & lngDiscId, dbOpenSnapshot)
If rstDiscClFrom.BOF And rstDiscClFrom.EOF Then
Exit Do
Else: rstDiscClFrom.MoveFirst
End If
'Loop through and copy discipline's classifications with new DiscId
Do While Not rstDiscClFrom.EOF
With rstDiscClTo
.AddNew
!DiscId = lngNewDiscId
!CodeClassId = rstDiscClFrom!CodeClassId
!CreditMin = rstDiscClFrom!CreditMin
!CourseMin = rstDiscClFrom!CourseMin
!SortOrder = rstDiscClFrom!SortOrder
!ClassNote = rstDiscClFrom!ClassNote
.Update
.Bookmark = rstDiscClTo.LastModified
lngNewDiscClassId = rstDiscClTo!DiscClassId
End With
lngDiscClassId = rstDiscClFrom!DiscClassId
Set rstDiscCrTo = CurrentDb.OpenRecordset("DiscCourse", dbOpenDynaset)
Set rstDiscCrFrom = CurrentDb.OpenRecordset("SELECT Cr.* FROM DiscCourse Cr INNER JOIN DiscClass Cl ON " _
& "Cr.DiscClassId = Cl.DiscClassId WHERE Cl.DiscClassId = " & lngDiscClassId, dbOpenSnapshot)
If rstDiscCrFrom.BOF And rstDiscCrFrom.EOF Then
Exit Do
Else: rstDiscCrFrom.MoveFirst
End If
'Loop through and copy discipline's classification's courses with new DiscClassId
Do While Not rstDiscCrFrom.EOF
With rstDiscCrTo
.AddNew
!DiscClassId = lngNewDiscClassId
!Course = rstDiscCrFrom!Course
!AnyPassingGrade = rstDiscCrFrom!AnyPassingGrade
!MinGradeId = rstDiscCrFrom!MinGradeId
!IncludeMajorGPA = rstDiscCrFrom!IncludeMajorGPA
!SortOrder = rstDiscCrFrom!SortOrder
.Update
End With
rstDiscCrFrom.MoveNext
Loop
rstDiscClFrom.MoveNext
Loop
MoveNextDisc:
rstDiscFrom.MoveNext
Loop
Forms!f_Main!sfrmDisc.Requery
Exit_Procedure:
On Error Resume Next
rstDiscTo.Close
Set rstDiscTo = Nothing
rstDiscFrom.Close
Set rstDiscFrom = Nothing
rstDiscClTo.Close
Set rstDiscClTo = Nothing
rstDiscClFrom.Close
Set rstDiscClFrom = Nothing
rstDiscCrTo.Close
Set rstDiscCrTo = Nothing
rstDiscCrFrom.Close
Set rstDiscCrFrom = Nothing
rstDiscCrExTo.Close
Set rstDiscCrExTo = Nothing
rstDiscCrExFrom.Close
Set rstDiscCrExFrom = Nothing
strStatus = SysCmd(acSysCmdClearStatus)
DoCmd.Hourglass False
DoCmd.SetWarnings True
Exit Sub
Error_Handler:
If Err.Number = 3022 Then
GoTo MoveNextDisc
Else
MsgBox "Error " & Err.Number & ": " & Err.Description, vbCritical
Resume Exit_Procedure
Resume
End If
End Sub