Here’s another common request.

Say you have a contacts report and like to print each client’s individual report separately as a PDF. How can this be done exactly? A concrete example might be a billing database in which you have an Invoice report (which would be comprised of all the records) and you’d like to print each invoice separately. Or just the outstanding invoices… you get the idea.

Generating PDFs on the Hard Drive

Approach 1 – Individual Reports

The General Concept

The general concept is pretty straightforward:

1. Defined a recordsource that you’re going to use to filter the report to get those records you seek
2. Open the report filtered based on the above
3. Print the report as a PDF
4. Close the report
5. Repeat for each record in 1

A Concrete Example

Enough with the blah blah, below is some sample code to inspire yourself from

Private Sub Command0_Click()
    Dim rs                    As DAO.Recordset
    Dim sFolder               As String
    Dim sFile                 As String
    Const sReportName = "NameOfYourReport"

    On Error GoTo Error_Handler

    'The folder in which to save the PDFs
    sFolder = Application.CurrentProject.Path & "\"

    'Define the Records that you will use to filtered the report with
    Set rs = CurrentDb.OpenRecordset("SELECT ContactID, FirstName FROM Contacts;", dbOpenSnapshot)
    With rs
        If .RecordCount <> 0 Then 'Make sure we have record to generate PDF with
            .MoveFirst
            Do While Not .EOF
                'Build the PDF filename we are going to use to save the PDF with
                sFile = sFolder & Nz(![FirstName], "") & ".pdf"
                'Open the report filtered to the specific record or criteria we want in hidden mode
                DoCmd.OpenReport sReportName, acViewPreview, , "[ContactID]=" & ![ContactID], acHidden
                'Print it out as a PDF
                DoCmd.OutputTo acOutputReport, sReportName, acFormatPDF, sFile, , , , acExportQualityPrint
                'Close the report now that we're done with this criteria
                DoCmd.Close acReport, sReportName
                'If you wanted to create an e-mail and include an individual report, you would do so now
                .MoveNext
            Loop
        End If
    End With

    'Open the folder housing the PDF files (Optional)
    Application.FollowHyperlink sFolder

Error_Handler_Exit:
    On Error Resume Next
    If Not rs Is Nothing Then
        rs.Close
        Set rs = Nothing
    End If
    Exit Sub

Error_Handler:
    If Err.Number <> 2501 Then    'Let's ignore user cancellation of this action!
        MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
               "Error Number: " & Err.Number & vbCrLf & _
               "Error Source: Command0_Click" & vbCrLf & _
               "Error Description: " & Err.Description & _
               Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
               , vbOKOnly + vbCritical, "An Error has Occurred!"
    End If
    Resume Error_Handler_Exit
End Sub

Approach 2 – A Single Filtered Report

The General Concept

The general concept is pretty straightforward:

1. Defined a recordsource that you’re going to use to filter the report to get those records you seek
2. Open the report to include all the records
3. Apply a filter to limit the report
4. Print the report as a PDF
5. Repeat 3 & 4 for each record in 1
6. Close the report

A Concrete Example

Private Sub Command1_Click()
    Dim rs                    As DAO.Recordset
    Dim rpt                   As Access.Report
    Dim sFolder               As String
    Dim sFile                 As String
    Const sReportName = "NameOfYourReport"

    On Error GoTo Error_Handler

    'The folder in which to save the PDFs
    sFolder = Application.CurrentProject.Path & "\"

    Set rs = CurrentDb.OpenRecordset("SELECT ContactID, FirstName FROM Contacts;", dbOpenSnapshot)
    With rs
        If .RecordCount <> 0 Then    'Make sure we have record to generate PDF with
            'Open the Report
            DoCmd.OpenReport sReportName, acViewPreview, , , acHidden
            'Define a report object so we can manipulate it below
            Set rpt = Reports(sReportName).Report
            .MoveFirst
            Do While Not .EOF
                'Build the PDF filename we are going to use to save the PDF with
                sFile = Nz(![firstname], "") & ".pdf"
                sFile = sFolder & sFile
                'filter the report to the specific record or criteria we want
                rpt.Filter = "[ContactID]=" & ![ContactID]
                rpt.FilterOn = True
                DoEvents 'This is critical or else the filter isn't applied!!!!
                'Print it out as a PDF
                DoCmd.OutputTo acOutputReport, sReportName, acFormatPDF, sFile, , , , acExportQualityPrint
                'If you wanted to create an e-mail and include an individual report, you would do so now
                .MoveNext
            Loop
            'Close the report now that we're done with this criteria
            DoCmd.Close acReport, sReportName
        End If
    End With

    'Open the folder housing the PDF files (Optional)
    Application.FollowHyperlink sFolder

Error_Handler_Exit:
    On Error Resume Next
    If Not rpt Is Nothing Then Set rpt = Nothing
    If Not rs Is Nothing Then
        rs.Close
        Set rs = Nothing
    End If
    Exit Sub

Error_Handler:
    If Err.Number <> 2501 Then    'Let's ignore user cancellation of this action!
        MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
               "Error Number: " & Err.Number & vbCrLf & _
               "Error Source: Command1_Click" & vbCrLf & _
               "Error Description: " & Err.Description & _
               Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
               , vbOKOnly + vbCritical, "An Error has Occurred!"
    End If
    Resume Error_Handler_Exit
End Sub

I haven’t had a chance to validate which approach is fastest. I suspect the 2nd approach would be best.

Some Important Things to Notes

What’s important to understand is that by controlling the line

Set rs = CurrentDb.OpenRecordset("SELECT ContactID, FirstName FROM Contacts;", dbOpenSnapshot)

You control which pages of the report you generate as PDF.

Say you wanted only the Active Contacts you might do

Set rs = CurrentDb.OpenRecordset("SELECT ContactID, FirstName FROM Contacts WHERE Active=True;", dbOpenSnapshot)

Or you wanted just the Canadian client

Set rs = CurrentDb.OpenRecordset("SELECT ContactID, FirstName FROM Contacts WHERE Country='Canada';", dbOpenSnapshot)

You get the idea.

Using This Technique With SendObject

You can adapt the above to even work with SendObject. By iterating over the recordset, we can then simply change the caption for each e-mail.

Sub CreateFilteredPDFsWithName()
    On Error GoTo Error_Handler
    Dim rs                    As DAO.Recordset
    Const sReportName = "NameOfYourReport"
 
    'Define the Records that you will use to filtered the report with
    Set rs = CurrentDb.OpenRecordset("SELECT ID, FirstName, LastName FROM Contacts;", dbOpenSnapshot)
    With rs
        If .RecordCount <> 0 Then 'Make sure we have record to generate PDF with
            .MoveFirst
            Do While Not .EOF
                'Open the report filtered to the specific record or criteria we want in hidden mode
                DoCmd.OpenReport sReportName, acViewPreview, , "[ContactID]=" & ![ContactID], acHidden
                'Change the Report's Caption (which is used as the FileName by SendObject)
                Reports(sReportName).Report.Caption = Nz(![FirstName], "") & "_" & Nz(![LastName], "") & "_" & Format(Now(), "yyyymmddhhnnss")
                'Generate The Email
                DoCmd.SendObject acSendReport, sReportName, acFormatPDF, , , , , , True
                'Close the report now that we're done with this criteria
                DoCmd.Close acReport, sReportName
                .MoveNext
            Loop
        End If
    End With
 
Error_Handler_Exit:
    On Error Resume Next
    If Not rs Is Nothing Then
        rs.Close
        Set rs = Nothing
    End If
    Exit Sub

Error_Handler:
    If Err.Number = 2501 Then
        'ignore error proceed with the next record
        Resume Next
        'Or exit nicely
'        Resume Error_Handler_Exit
    Else
        MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
            "Error Source: CreateFilteredPDFsWithName2" & vbCrLf & _
            "Error Number: " & Err.Number & vbCrLf & _
            "Error Description: " & Err.Description & _
            Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
            , vbOKOnly + vbCritical, "An Error has Occurred!"
        Resume Error_Handler_Exit
    End If
End Sub