question

PaulDaniels-0843 avatar image
0 Votes"
PaulDaniels-0843 asked

Splitting an Access report into seperate pdf files

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
5 |1600 characters needed characters left characters exceeded

Up to 10 attachments (including images) can be used with a maximum of 3.0 MiB each and 30.0 MiB total.

0 Answers