Microsoft Access Tips for Serious Users

Provided by Allen Browne, April 2007

Code accompanying article: Has the record been printed?

The article Has the record been printed? shows how to create print runs (batches) that track when new records are printed.

The code below lists the code behind the 3 buttons. Download the sample database if you prefer (27 kb zipped, Access 2000 and later.)

Option Compare Database
Option Explicit

Private Sub cmdCreateBatch_Click()
'On Error GoTo Err_Handler
    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    Dim strSql As String
    Dim lngBatchID As Long
    Dim lngKt As Long
    
    'Create the new batch, and get the number.
    Set db = CurrentDb()
    Set rs = db.OpenRecordset("tblBatch", dbOpenDynaset, dbAppendOnly)
    rs.AddNew
        rs!BatchDateTime = Now()
        lngBatchID = rs!BatchID
    rs.Update
    rs.Close
    
    'Give this batch number to all members who have not been printed.
    strSql = "UPDATE tblMember SET BatchID = " & lngBatchID & " WHERE BatchID Is Null;"
    db.Execute strSql, dbFailOnError
    lngKt = db.RecordsAffected
    
    'Show the response.
    Me.lstBatch.Requery
    MsgBox "Batch " & lngBatchID & " contains " & lngKt & " member(s)."
    
Exit_Handler:
    Set rs = Nothing
    Set db = Nothing
    Exit Sub

Err_Handler:
    MsgBox "Error " & Err.Number & ": " & Err.Description, vbExclamation, "cmdCreateBatch_Click()"
    Resume Exit_Handler
End Sub

Private Sub cmdPrintBatch_Click()
'On Error GoTo Err_Handler
    Dim strWhere As String
    Const strcDoc = "rptMemberList"
    
    If IsNull(Me.lstBatch) Then
        MsgBox "Select a batch to print."
    Else
        'Close the report if it's already open (so the filtering is right.)
        If CurrentProject.AllReports(strcDoc).IsLoaded Then
            DoCmd.Close acReport, strcDoc
        End If
        'Open it filtered to the batch in the list box.
        strWhere = "BatchID = " & Me.lstBatch
        DoCmd.OpenReport strcDoc, acViewPreview, , strWhere
    End If

Exit_Handler:
    Exit Sub

Err_Handler:
    MsgBox "Error " & Err.Number & ": " & Err.Description, vbExclamation, ".cmdPrintBatch_Click"
    Resume Exit_Handler
End Sub

Private Sub cmdUndoBatch_Click()
'On Error GoTo Err_Handler
    Dim db As DAO.Database
    Dim strSql As String
    Dim varBatchID As Variant
    Dim lngKt As Long
    
    'Get the highest batch number.
    varBatchID = DMax("BatchID", "tblBatch")
    If IsNull(varBatchID) Then
        MsgBox "No batches found."
    Else
        'Clear all the members of the batch.
        Set db = CurrentDb()
        strSql = "UPDATE tblMember SET BatchID = Null WHERE BatchID = " & varBatchID & ";"
        db.Execute strSql, dbFailOnError
        'Delete the batch.
        strSql = "DELETE FROM tblBatch WHERE BatchID = " & varBatchID & ";"
        db.Execute strSql, dbFailOnError
        lngKt = db.RecordsAffected
        
        'Show the response.
        Me.lstBatch.Requery
        MsgBox "Batch " & varBatchID & " deleted. " & lngKt & " member(s) marked as not printed."
    End If

Exit_Handler:
    Set db = Nothing
    Exit Sub

Err_Handler:
    MsgBox "Error " & Err.Number & ": " & Err.Description, vbExclamation, ".cmdUndoBatch_Click"
    Resume Exit_Handler
End Sub