Create A Single PDF File Per Record Report Using VBA & MS Access


This one was a tricky request. What I had was a recordset from a query in MS Access. I needed to create a report where when printed it would create one PDF file per record. MS Access has the ability to print directly to PDF. The trick was sending only one record to the report so that only one file would be created per record…

Here the outline of the process that worked for me.

  1. Create the report as desired based on some query
  2. Query a unique list of ID’s (Primary Keys) from the recordset used for the report
  3. Create a Query in VBA (Query from #1) that I could add the ID from #2 that would return the data for just one of the records in the underlying table.
  4. Loop through the records (returning only one record) and pass it to the report to output the PDF file as desired

Here’s the code with notes

'Pass in the Query that the report is based on
Function modPDF_Print(strQry As String)

Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim rs1 As DAO.Recordset
Dim strFileName As String
Dim strFolder As String
Dim strSQL As String


'Set the folder where the files will be saved
strFolder = "C:\"

'This is the SQL query that will return a single record.  It's the SQL version of the query that runs your report with the ID field added.  The ID field is the primary key from the underlying table you query is based on. This ID is used to select JUST ONE RECORD for the report - one PDF per record
StrSQLBase = "SELECT ...Fields Here.... .ID="


Set db = CurrentDb()
'strQry are all records passed into the function - Create the recordset rs1
Set rs1 = db.OpenRecordset(strQry) 
' this is a direct query to the underlying table for for strQry.  This gives you a list of Primary Keys (ID). Create the recordset rs
Set rs = db.OpenRecordset("SELECT ID From [Underlying Table for strQry]") 
On Error GoTo Error_Handler

'if no records are found in the query passed to the function - exit
If rs.RecordCount = 0 Then
    Exit Function
End If
 
'move to the first record of rs (Get the first ID)
rs.MoveFirst
Do While Not rs.EOF
'build a query to pull all the data need for the report for the first ID.  Just append the ID to strSQLBase.  This gets us just one record to send to the PDF
strSQL = StrSQLBase & rs.Fields("ID").Value & "));"

' Now get that one record
Set rs1 = db.OpenRecordset(strSQL)
'If nothing returned exit
    If rs1.RecordCount = 0 Then
        Exit Function
    End If
'access the data for that one record    
    rs1.MoveFirst
    Do While Not rs1.EOF
'Build the filename - in this example I wanted the filename to use data from the single record.  In this case Site Number and Parcel Acct Num plus the date makes up the file name
        strFileName = rs1.Fields("Site Number").Value
        strFileName = strFolder & "\" & strFileName & "-" & rs1.Fields("Parcel Acct Num").Value & "-AAF-" & Format(Now(), "YYYY-MM-DD") & ".pdf"
   
' Now we have Access preview the report passing it the one record using ID - and it's hidden to you don't see the preview
        DoCmd.OpenReport "Rpt_AssetActionForm", acViewPreview, , "[ID]=" & rs1.Fields("ID").Value, acHidden

'Now we output to the actual PDF file.
        DoCmd.OutputTo acOutputReport, "Rpt_AssetActionForm", acFormatPDF, strFileName, , , , acExportQualityPrint

'Here we close the form so we can loop to the next record
        DoCmd.Close acReport, "Rpt_AssetActionForm"

   rs1.MoveNext
   Loop
   rs1.Close
   rs.MoveNext
 'Now we loop and start the process over with the NEXT ID 
Loop

'Clean up and close out
rs.Close
Set rs = Nothing
Set db = Nothing



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

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

End Function

All credit to getting me started on this comes from https://social.msdn.microsoft.com/Forums/office/en-US/53f85f8b-6800-4c5a-a8c8-c974ca6b4d53/print-each-record-to-separate-pdf-file-using-certain-field-for-filename?forum=accessdev

Recent Content