How to Handle Run-Time Error 3022

Collapse
X
 
  • Time
  • Show
Clear All
new posts
  • bullfrog83
    New Member
    • Apr 2010
    • 124

    #1

    How to Handle Run-Time Error 3022

    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:

    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
    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?
Working...