Expand|Select|Wrap|Line Numbers
- 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