Provided by Allen Browne, April 2007
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
Home | Index of tips | Top |