Splitting an Access report into seperate pdf files

Paul Daniels 1 Reputation point
2021-10-29T12:48:31.367+00:00

HI all

This is driving me up the wall! I have a Access Database which I have a report for client statements. Of course when I run this report it produces one big combined file - I am trying to get it so save each account as a separate pdf fine based on Acc Code.

The report is 'WAT Statement' - the query is also 'WAT Statement' and the account code is 'Acc Code' ....my code at the moment is the following but it's not quite working....any ideas? VBA is not my strong point!!

Private Sub Command23_Click()
Dim rs As DAO.Recordset
Dim sFolder As String
Dim sFile As String
Const sReportName = "WAT Statement"

On Error GoTo Error_Handler

'The folder in which to save the PDFs
sFolder = "C:\Test\"

'Define the Records that you will use to filtered the report with
Set rs = CurrentDb.OpenRecordset("SELECT [Acc Code] FROM [WAT Statement];", 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(![Acc Code], "") & ".pdf"
            'Open the report filtered to the specific record or criteria we want in hidden mode
            DoCmd.OpenReport sReportName, acViewPreview, , "[Acc Code]=" & ![Acc Code], 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

Microsoft Authenticator
Microsoft Authenticator
A Microsoft app for iOS and Android devices that enables authentication with two-factor verification, phone sign-in, and code generation.
5,533 questions
0 comments No comments
{count} votes