Deleting or Appending Records Using SQL and db.Execute
Frequently it is necessary to remove a certain set of records based on a filter. This example shows how to delete records using both the SQL and db.Execute approach.
Program Code
Option Compare Database
Option Explicit
Public Function DeleteRecordsUsingSQL()
' ***************************************************
' * Demonstrate How To Delete Records Using SQL *
' ***************************************************
Dim db As DAO.Database
Dim recIn As DAO.Recordset
Dim strSQL As String
Dim strKeyToDelete As String
On Error GoTo ErrorHandler
Set db = CurrentDb()
strKeyToDelete = "Ashland"
strSQL = "DELETE * FROM tblCity WHERE tblCity.City = " & """" & strKeyToDelete & """" & ";"
db.Execute strSQL, dbFailOnError
MsgBox db.RecordsAffected & " record(s) were deleted."
On Error GoTo 0
ExitTheFunction:
Set db = Nothing
Exit Function
ErrorHandler:
CommonErrorHandler Err.Number, Err.Description
Resume ExitTheFunction
End Function
Public Sub CommonErrorHandler(ErrorNumber As String, ErrorDescription As String)
MsgBox "An Error Occurred In This Application" & vbCrLf & _
"Please Contact The Developer" & vbCrLf & vbCrLf & _
"Error Number = " & ErrorNumber & " Error Description = " & _
ErrorDescription, vbCritical
End Sub
' ************************************************************************
' Another Example
' ************************************************************************
Private Sub DeleteMASVendorInvoice()
On Error GoTo ErrorHandler
Set db = CurrentDb()
strKeyToDelete = Me.txtVendorNo & Me.txtInvoiceNo
strSQL = "DELETE * FROM AP_Freight_MAS_GL_Entries WHERE AP_Freight_MAS_GL_Entries.VendorNoInvoiceNo = " _
& """" & strKeyToDelete & """" & " "
strSQL = strSQL & "AND (AP_Freight_MAS_GL_Entries.MASTimeStamp Is Null Or Not IsDate(AP_Freight_MAS_GL_Entries.MASTimeStamp)" & ");"
db.Execute strSQL, dbFailOnError
On Error GoTo 0
ExitTheFunction:
Set db = Nothing
Exit Sub
ErrorHandler:
CommonErrorHandler Err.Number, Err.Description
Resume ExitTheFunction
End Sub
' ************************************************************************
' Another Example using the APPEND keyword
' ************************************************************************
Option Compare Database
Option Explicit
' ***********************************************************************
' Create Transaction History From MAX by Year
' ***********************************************************************
Public Function CreateTransactionHistory()
Dim strSQL As String
Dim dteStartTime As Single
Dim dteEndTime As Single
dteStartTime = Timer
' ***********************************************************************
' Append One Year of Transaction History From MAX to Local Table
' ***********************************************************************
strSQL = "INSERT INTO [tblPurchaseOrderCode] " & _
"SELECT * FROM [Purchase Order Code] " & _
"WHERE ORDDTE_16 >= #01/01/2003# AND ORDDTE_16 <= #12/31/2013#"
CurrentDb.Execute strSQL, dbFailOnError
' ***********************************************************************
' Notify User of the Time
' ***********************************************************************
dteEndTime = Timer
MsgBox ("Run Time = " & dteEndTime - dteStartTime & " Seconds")
End Function
Option Compare Database
Option Explicit
Private Sub cmdProceed_Click()
' *****************************************************************
' This Demonstrates Deleting Records From The Same Table
' That Supplies Entries in a List Box Using db.Execute
' Also Reading Recordsets from SQL Strings
' ******************************************************************
Dim db As DAO.Database
Dim recIn As DAO.Recordset
Dim varSelectedClientID As Variant
Dim lngClientIDToBePurged As Long
Dim strClientNameToPurge As String
Dim lngResponse As Long
Dim qd As DAO.QueryDef
Dim strSQL As String
Dim strSQLSelect As String
Set db = CurrentDb()
strSQLSelect = "Select * From tblEmployees"
' ******************************************************************
' Loop Through Delete Selections
' ******************************************************************
If Me.lstEmployees.ItemsSelected.Count = 0 Then
MsgBox ("You Must Select At Least 1 Employee To Be Purged")
Exit Sub
End If
With Me.lstEmployees
For Each varSelectedClientID In .ItemsSelected
If Not IsNull(varSelectedClientID) Then
lngClientIDToBePurged = .ItemData(varSelectedClientID)
lngResponse = MsgBox("Are You Sure You Want To Purge " & _
Me.lstEmployees.Column(0, varSelectedClientID) & "?", vbYesNo)
If lngResponse = vbYes Then
On Error GoTo ErrorHandler
strSQL = "DELETE tblEmployees.ID, tblEmployees.EmployeeName FROM tblEmployees WHERE tblEmployees.ID = " & _
lngClientIDToBePurged
db.Execute strSQL, dbFailOnError
' ******************************************************************
' Make Sure It Was Deleted
' ******************************************************************
Set recIn = db.OpenRecordset(strSQLSelect)
If Not recIn.EOF Then
Do
MsgBox ("Employee = " & recIn!EmployeeName & vbCrLf & _
"EmployeeID = " & recIn!ID)
recIn.MoveNext
Loop Until recIn.EOF
recIn.Close
Set recIn = Nothing
End If
End If
End If
Next
End With
Exit Sub
' *****************************************************************************
' Handle Errors
' *****************************************************************************
ErrorHandler:
HandleError Err.Number, Err.Description, "Purge Employers", Me.Name
Err.Clear
Resume Next
End Sub
Private Sub HandleError(intErr As Long, strErrorDescription As String, strFunction As String, strObject As String)
On Error Resume Next
MsgBox ("Error #------------------ " & intErr & vbCrLf & "Error Description-------- " & strErrorDescription & vbCrLf & _
"Processing Function---- " & strFunction & vbCrLf & "Error in Access Object-- " & strObject)
End Sub