V
Velcerick
Hello,
I have a database that uses the code below to delete records from one table
and move them to a separate table for archival purposes. Until recently, the
code worked fine. Now, I'm getting an "Overflow" error. It seems to be tied
to the value of the ActivityID field in my primary table, as I can delete
older records, but not newer ones using this code. The fields are all
identical between both tables. Any suggestions on what I can do to correct
this?
Vel.
Public Function AddDelete(stTable As String, stDeleting As String, stForm As
String, stCriteria As Integer)
Dim strSQLAdd As String
Dim strSQLDel As String
Dim db As DAO.Database
Dim qd As DAO.QueryDef
Dim ws As DAO.Workspace
Dim bInTrans As Boolean
Dim stProvider As String
On Error GoTo Proc_Error
stProvider = Forms!frmLogOn!cboProviderID.Column(0)
bInTrans = False
strSQLAdd = "INSERT INTO [DEL" & stTable & "] SELECT * FROM [tbl" & stTable
& "] WHERE [tbl" & stTable & "].[" & stDeleting & "ID]=" & stCriteria & ";"
strSQLDel = "DELETE * FROM [tbl" & stTable & "] WHERE [tbl" & stTable &
"].[" & stDeleting & "ID]=" & stCriteria & ";"
strSQLUpd = "UPDATE [DEL" & stTable & "] SET [DEL" & stTable &
"].[DeletedBy]='" & stProvider & "' WHERE [DEL" & stTable & "].[" &
stDeleting & "ID]=" & stCriteria & ";"
' for safety's sake create a Transaction to run both queries
' This will ensure that they either both run, or neither runs
Set ws = DBEngine(0) ' current workspace
Set db = CurrentDb
ws.BeginTrans
bInTrans = True ' for error trapping; you're now in a Transaction
Set qd = db.CreateQueryDef("", strSQLAdd) ' new nameless query
qd.Execute dbFailOnError ' run it
Set qd = db.CreateQueryDef("", strSQLDel)
qd.Execute dbFailOnError
' if no error occurs commit the transaction to finalize
ws.CommitTrans
DoCmd.RunSQL strSQLUpd
MsgBox "The Record Was Successfully Deleted", , "Record Deleted"
Proc_Exit: Exit Function
Proc_Error:
MsgBox Err.Description
If bInTrans Then ' are we in a transaction?
ws.Rollback ' roll it back, i.e. cancel any pending changes
End If
Resume Proc_Exit
End Function
I have a database that uses the code below to delete records from one table
and move them to a separate table for archival purposes. Until recently, the
code worked fine. Now, I'm getting an "Overflow" error. It seems to be tied
to the value of the ActivityID field in my primary table, as I can delete
older records, but not newer ones using this code. The fields are all
identical between both tables. Any suggestions on what I can do to correct
this?
Vel.
Public Function AddDelete(stTable As String, stDeleting As String, stForm As
String, stCriteria As Integer)
Dim strSQLAdd As String
Dim strSQLDel As String
Dim db As DAO.Database
Dim qd As DAO.QueryDef
Dim ws As DAO.Workspace
Dim bInTrans As Boolean
Dim stProvider As String
On Error GoTo Proc_Error
stProvider = Forms!frmLogOn!cboProviderID.Column(0)
bInTrans = False
strSQLAdd = "INSERT INTO [DEL" & stTable & "] SELECT * FROM [tbl" & stTable
& "] WHERE [tbl" & stTable & "].[" & stDeleting & "ID]=" & stCriteria & ";"
strSQLDel = "DELETE * FROM [tbl" & stTable & "] WHERE [tbl" & stTable &
"].[" & stDeleting & "ID]=" & stCriteria & ";"
strSQLUpd = "UPDATE [DEL" & stTable & "] SET [DEL" & stTable &
"].[DeletedBy]='" & stProvider & "' WHERE [DEL" & stTable & "].[" &
stDeleting & "ID]=" & stCriteria & ";"
' for safety's sake create a Transaction to run both queries
' This will ensure that they either both run, or neither runs
Set ws = DBEngine(0) ' current workspace
Set db = CurrentDb
ws.BeginTrans
bInTrans = True ' for error trapping; you're now in a Transaction
Set qd = db.CreateQueryDef("", strSQLAdd) ' new nameless query
qd.Execute dbFailOnError ' run it
Set qd = db.CreateQueryDef("", strSQLDel)
qd.Execute dbFailOnError
' if no error occurs commit the transaction to finalize
ws.CommitTrans
DoCmd.RunSQL strSQLUpd
MsgBox "The Record Was Successfully Deleted", , "Record Deleted"
Proc_Exit: Exit Function
Proc_Error:
MsgBox Err.Description
If bInTrans Then ' are we in a transaction?
ws.Rollback ' roll it back, i.e. cancel any pending changes
End If
Resume Proc_Exit
End Function