Coleman984
Registered User.
- Local time
- Today, 04:30
- Joined
- Jul 28, 2011
- Messages
- 89
I'm trying to use this macro (not designed by me) to try to archive records older than 1 year.
The part that is erroring out is directly below, the entire macro is below that.
Keeps telling me that there is a syntax error. the origin table is tblEmployeeAttendance, the table being inserted into is tblEmployeeAttendance_archive , the fields to be copied are the same in both tables and are as follows: pkEmpAttID, fkEmployeeID, dteAttendance, fkAttendanceTypeID.
What am I doing wrong?
The part that is erroring out is directly below, the entire macro is below that.
Keeps telling me that there is a syntax error. the origin table is tblEmployeeAttendance, the table being inserted into is tblEmployeeAttendance_archive , the fields to be copied are the same in both tables and are as follows: pkEmpAttID, fkEmployeeID, dteAttendance, fkAttendanceTypeID.
What am I doing wrong?
Code:
strSql = "INSERT INTO tblEmployeeAttendance_archive ( pkEmpAttID, fkEmployeeID, dteAttendance,fkAttendanceTypeID ) " & _
"IN " & cDB & _
"SELECT pkEmpAttID, fkEmployeeID, dteAttendance, fkAttendanceTypeID FROM tblEmployeeAttendance WHERE (dteAttendance <= " & DateMin1Yr & ");"
Code:
Function DoArchive()
On Error GoTo Err_DoArchive
Dim ws As DAO.Workspace 'Current workspace (for transaction).
Dim db As DAO.Database 'Inside the transaction.
Dim bInTrans As Boolean 'Flag that transaction is active.
Dim strSql As String 'Action query statements.
Dim strMsg As String 'MsgBox message.
Dim cDB As String
Dim DateMin1Yr As String
DateMin1Yr = DateAdd("yyyy", -1, Date)
cDB = currentdb.Name
'Step 1: Initialize database object inside a transaction.
Set ws = DBEngine(0)
ws.BeginTrans
bInTrans = True
Set db = ws(0)
'Step 2: Execute the append.
strSql = "INSERT INTO tblEmployeeAttendance_archive ( pkEmpAttID, fkEmployeeID, dteAttendance,fkAttendanceTypeID ) " & _
"IN " & cDB & _
"SELECT pkEmpAttID, fkEmployeeID, dteAttendance, fkAttendanceTypeID FROM tblEmployeeAttendance WHERE (dteAttendance <= " & DateMin1Yr & ");"
db.Execute strSql, dbFailOnError
'Step 3: Execute the delete.
strSql = "DELETE FROM tblEmployeeAttendance WHERE (dteAttendance <= " & DateMin1Yr & ");"
db.Execute strSql, dbFailOnError
'Step 4: Get user confirmation to commit the change.
strMsg = "Archive " & db.RecordsAffected & " record(s)?"
If MsgBox(strMsg, vbOKCancel + vbQuestion, "Confirm") = vbOK Then
ws.CommitTrans
bInTrans = False
End If
Exit_DoArchive:
'Step 5: Clean up
On Error Resume Next
Set db = Nothing
If bInTrans Then 'Rollback if the transaction is active.
ws.Rollback
End If
Set ws = Nothing
Exit Function
Err_DoArchive:
MsgBox Err.Description, vbExclamation, "Archiving failed: Error " & Err.Number
Resume Exit_DoArchive
End Function