Option Compare Database
Private Sub cmdArchiveData_Click()
Dim strSQLAppend As String
Dim strSQLDelete As String
Dim errLoop As Error
Dim dteExpiry As Date
dteExpiry = DateAdd("yyyy", -2, Date)
strSQLAppend = "INSERT INTO tblExpiredStudents " & _
"( strStudentID, strFirstName, strLastName, strAddress1, " & _
"strAddress2, strCity, strCounty, strPostCode, strTelephone, " & _
"[hypE-mailAddress], dtmDOB, dtmEnrolled, strCourseID ) " & _
"SELECT tblStudentInformation.strStudentID, " & _
"tblStudentInformation.strFirstName, " & _
"tblStudentInformation.strLastName, " & _
"tblStudentInformation.strAddress1, " & _
"tblStudentInformation.strAddress2, " & _
"tblStudentInformation.strCity, " & _
"tblStudentInformation.strCounty, " & _
"tblStudentInformation.strPostCode, " & _
"tblStudentInformation.strTelephone, " & _
"tblStudentInformation.[hypE-mailAddress], " & _
"tblStudentInformation.dtmDOB, " & _
"tblStudentInformation.dtmEnrolled, " & _
"tblStudentInformation.strCourseID " & _
"FROM tblStudentInformation " & _
"WHERE tblStudentInformation.dtmEnrolled <= #" & dteExpiry & "#;"
strSQLDelete = "DELETE tblStudentInformation.strStudentID, " & _
"tblStudentInformation.strFirstName, " & _
"tblStudentInformation.strLastName, " & _
"tblStudentInformation.strAddress1, " & _
"tblStudentInformation.strAddress2, " & _
"tblStudentInformation.strCity, " & _
"tblStudentInformation.strCounty, " & _
"tblStudentInformation.strPostCode, " & _
"tblStudentInformation.strTelephone, " & _
"tblStudentInformation.[hypE-mailAddress], " & _
"tblStudentInformation.dtmDOB, " & _
"tblStudentInformation.dtmEnrolled, " & _
"tblStudentInformation.strCourseID " & _
"FROM tblStudentInformation " & _
"WHERE tblStudentInformation.dtmEnrolled <= #" & dteExpiry & "#;"
On Error GoTo Err_Execute
CurrentDb.Execute strSQLAppend, dbFailOnError
CurrentDb.Execute strSQLDelete, dbFailOnError
On Error GoTo 0
Exit Sub
Err_Execute:
If DBEngine.Errors.Count > 0 Then
For Each errLoop In DBEngine.Errors
MsgBox "Error number: " & errLoop.Number & vbCr & _
errLoop.Description
Next errLoop
End If
Resume Next
End Sub
Private Sub cmdExpiredStudents_Click()
DoCmd.OpenTable "tblExpiredStudents"
End Sub
Private Sub cmdOpenStudentTable_Click()
DoCmd.OpenTable "tblStudentInformation"
End Sub
Private Sub lblClose_Click()
DoCmd.Close acForm, "frmArchive"
End Sub