Access Report to multiple PDF Files

Topic

New Reply

Hi, I need help with running an Access 2010 mdb report to multiple PDF files, my report is grouped by Surveyor with a page break at each change in Surveyor and I need a separate PDF for each Surveyor. My report is based upon the following query (SQL code). Query name is q_Survey_MS and the report name is r-Uninspected_Survey_Report

SELECT [t_surveyor]![first_name] & ” ” & [t_surveyor]![surname] AS Surveyor, t_survey.survey_id AS [Survey ID], t_survey.insured, t_survey.policy_number, t_survey.date_required AS [Date required], t_survey.survey_date AS Inspected, t_survey.report_completed_date AS Reported, t_survey.date_requested AS [Date requested], [t_user]![user_name] AS [Responsible Underwriter], t_post_code.suburb, t_survey.policy_due_date, t_cob.cob_code, t_surveyor.zone
FROM (((((t_survey LEFT JOIN t_post_code ON t_survey.suburb = t_post_code.post_code_id) LEFT JOIN t_state ON t_survey.state_id = t_state.state_id) LEFT JOIN t_surveyor ON t_survey.surveyor_id = t_surveyor.surveyor_id) LEFT JOIN t_requested_by ON t_survey.requested_by_id = t_requested_by.requested_by_id) LEFT JOIN t_cob ON t_survey.cob_id = t_cob.cob_id) INNER JOIN t_user ON t_survey.responsible_uw_id = t_user.user_id
WHERE (((t_survey.survey_date) Is Null) AND ((t_survey.report_completed_date) Is Null))
ORDER BY t_survey.date_required;

I have a vague idea of the code needed, but need more help to implement it. I know that I will need a record set and some sort of looping through the Surveyors, I will also need to save the PDFs to a sub directory of the location of the database. Any help would be appreciated.

Reply | Quote

Replies

Maria,

Here’s the code I use to send our HOA Dues emails:

Code:

'                         +-------------------------+             +----------+
'-------------------------|      EmailBills()       |-------------| 01/11/12 |
'                         +-------------------------+             +----------+
'Requires : PDFCreator {Open Source PDF Printer Driver}
'           Sleep      {Windows API Function Declaration}
'Called By:
'Calls: ClearPDFDirectory()
'       SetDateForBills()
'       [Utilities] SwitchPrinters()
'       [Utilities] zGetDBPath()

Sub EmailBills()

   Dim dbName     As Database
   Dim rst        As Recordset
   Dim lRecNo     As Long
   Dim lBillCnt   As Long
   Dim zWhere     As String
   Dim zMsgBody   As String
#If LateBinding = 0 Then    'Early Binding
   Dim appOL      As Outlook.Application
   Dim miMail     As Outlook.mailitem
#Else
   Dim appOL      As Object
   Dim miMail     As Object
#End If

   Dim oMyAttach  As Object
   Dim zAttFN     As String
   Dim zBillPath  As String
   
   If Not SetDateForBills() Then
     Exit Sub
   End If
   
   MsgBox "Please Note:" & vbCrLf & vbCrLf & _
          "If Microsoft Outlook is Closed the created Emails " & vbCrLf & _
          "will be sent to the INBOX folder." & vbCrLf & vbCrLf & _
          "If Microsoft Outlook is OPEN {recommended} the created Emails " _
          & vbCrLf & "will be sent to the DRAFTS folder." & vbCrLf & vbCrLf & _
          "When OUTLOOK is properly set press OK", _
          vbOKOnly + vbInformation, _
          "IMPORTANT INFORMATION:"
          
   zBillPath = zGetDBPath() & "EmailBills"
          
   ClearPDFDirectory
   strDfltPrt = Application.Printer.DeviceName
   SwitchPrinters "PDFCreator"
   
   Set appOL = CreateObject("Outlook.Application")
   Set dbName = CurrentDb()
   Set rst = dbName.OpenRecordset("Owners", dbOpenDynaset)
   rst.MoveFirst
   
   lBillCnt = 0
   zMsgBody = "Please find your WPOA annual dues statement attached." & _
              vbCrLf & vbCrLf & "WOPA Board of Directors" & vbCrLf & _
              vbCrLf & "Attachment: "
   Do
     If (rst![EMailDocs] And rst![EMail]  "") Then
     
       zWhere = "[OwnerID] = " & Str(rst![OwnerID])
   
'Note: If acNormal is selected the report is send automatically to the
'      Default printer!
'      If acPreview is selected the report is sent to the screen.

       DoCmd.OpenReport "rptAnnualBilling", acNormal, , zWhere
   
'******* Rename file with OwnerID

On Error GoTo WaitForPDFCreator
Try_Again:

       Do While Dir(zBillPath & "rptAnnualBilling.pdf") = vbNullString
         Sleep 1250           '** wait 1.25 secs before trying again **
       Loop
       
       Name zBillPath & "rptAnnualBilling.pdf" As _
            zBillPath & "Bill" & Format(rst![OwnerID]) & ".pdf"
On Error GoTo 0
'******* Begin Send Email

#If LateBinding = 0 Then
       Set miMail = appOL.CreateItem(olMailItem)  '*** olMailItem = 0 ***
#Else
       Set miMail = appOL.CreateItem(0)
#End If

       With miMail
           .To = rst![EMail]
           .Subject = "WPOA Annual Dues Statement: " & rst![OwnerLName]
           .Body = zMsgBody & "Bill" & Trim(Str(rst![OwnerID])) & _
                   " Owner: " & rst![OwnerLName]
           .ReadReceiptRequested = True
           zAttFN = zBillPath & "Bill" & _
                    Trim(Str(rst![OwnerID])) & ".pdf"
           Set oMyAttach = miMail.Attachments.Add(zAttFN)
           .Save
       End With   'miMail

       Set miMail = Nothing
       lBillCnt = lBillCnt + 1  '*** Count Emails Created ***

'******* End Send Email

     End If
     
     rst.MoveNext        '*** Move to Next Record ***
   
   Loop Until rst.EOF
   
   MsgBox Format(lBillCnt, "#,###") & " Email Bills Created." & _
          vbCrLf & vbCrLf & _
          "Maximize Outlook and Press F8 and select the" & _
          "SendAllDrafts macro then click Run." & _
          vbCrLf & vbCrLf & _
          "If Outlook wasn't open when you created the Email" & _
          vbCrLf & "Bills you will have to move them to the" & _
          vbCrLf & "Drafts folder from the Inbox BEFORE you" & _
          vbCrLf & "run the macro!", vbOKOnly + vbInformation, _
          "Next Step:"
   GoTo GetOut

WaitForPDFCreator:
   Select Case Err.Number
         Case 75
             Sleep 0.75  '*** Wait another 3/4 second. ***
             Resume Try_Again
         Case Else
             MsgBox "Module:" & vbTab & "BillingsCode" & vbCrLf & _
                    "Routine:" & vbTab & "EmailMailBills" & vbCrLf & _
                    "Error: " & Err.Number & " " & _
                    Err.Description, vbCritical + vbOKOnly, _
                    "Unexpected Error:"
             Resume GetOut
   End Select
   
GetOut:
   Set rst = Nothing     '*** Close RecordSet ***
   Set oMyAttach = Nothing
   Set miMail = Nothing
   Set appOL = Nothing
   
   SwitchPrinters strDfltPrt
   
End Sub                   '*** EmailBills() ***

'                         +-------------------------+             +----------+
'-------------------------|   ClearPDFDirectory()   |-------------| 10/28/10 |
'                         +-------------------------+             +----------+
'Called By: EmailBills()
'Calls: N/A
'Purpose: Clear out directory so that the NAME command doesn't cause errors!

Sub ClearPDFDirectory()

   Dim zEmailBillFN   As String
   Dim zEmailBillPath As String
   
   zEmailBillPath = zGetDBPath() & "EmailBills"
   
   zEmailBillFN = Dir(zEmailBillPath & "*.pdf")
   
   Do Until zEmailBillFN = ""
     Debug.Print zEmailBillFN
     Kill zEmailBillPath & zEmailBillFN
     zEmailBillFN = Dir()
   Loop
   
End Sub                 '*** ClearPDFDirectory() ***

This code relies on PDFCreator (free pdf utility) as the output printer.

The key is looping through the database and only printing one member’s bill at a time.

HTH :cheers:

May the Forces of good computing be with you!

RG

PowerShell & VBA Rule!
Computer Specs

Reply | Quote

Thanks for that RetiredGeek, how would I modify this to not use ClearPDF as a printer and to not use Outlook – there are no email addresses in the report?

Reply | Quote

Maria,

Here’s the best I can do w/o your DB to test.

Code:

'Declare Sleep API
Private Declare Sub Sleep Lib "kernel32" (ByVal nMilliseconds As Long)

Public zDBPath as String   [COLOR="#0000CD"]'The location of your .dbf file if split DB the BackEnd DB!
[/COLOR]
'                         +-------------------------+             +----------+
'-------------------------|      EmailBills()       |-------------| 01/11/12 |
'                         +-------------------------+             +----------+
'Requires : PDFCreator {Open Source PDF Printer Driver}
'           Sleep      {Windows API Function Declaration}
'Called By:
'Calls:     ClearPDFDirectory()
'           SwitchPrinters()

Sub EmailBills()

   Dim dbName      As Database
   Dim rst         As Recordset
   Dim lRecNo      As Long
   Dim lBillCnt    As Long
   Dim zWhere      As String
    Dim zReportPath As String
   
   zDBPath = "[COLOR="#0000CD"]C:Access...[/COLOR]"  [COLOR="#0000CD"] '*** Fully qualified path to your DB do not include file name ***[/COLOR]
   zReportPath = zDBPath & "Reports"
          
   ClearPDFDirectory
   strDfltPrt = Application.Printer.DeviceName
   SwitchPrinters "PDFCreator"
   
   Set dbName = CurrentDb()
   Set rst = dbName.OpenRecordset("[COLOR="#0000CD"]Owners[/COLOR]", dbOpenDynaset) [COLOR="#0000CD"]'*** Your Table Name Here ***[/COLOR]
   rst.MoveFirst
   
   lBillCnt = 0

   Do
      
       zWhere = "[[COLOR="#0000CD"]OwnerID[/COLOR]] = " & Str(rst![[COLOR="#0000CD"]OwnerID[/COLOR]]) [COLOR="#0000CD"]'*** Modify w/your fields/selection criteria ***[/COLOR]
   
'Note: If acNormal is selected the report is send automatically to the
'      Default printer!
'      If acPreview is selected the report is sent to the screen.

       DoCmd.OpenReport "[COLOR="#0000CD"]rptAnnualBilling[/COLOR]", acNormal, , zWhere  [COLOR="#0000CD"]'*** Your Report Name Here ***[/COLOR]
   
'******* Rename file with OwnerID

On Error GoTo WaitForPDFCreator
Try_Again:

       Do While Dir(zReportPath & "rptAnnualBilling.pdf") = vbNullString
         Sleep 1250           '** wait 1.25 secs before trying again **
       Loop
       
       Name zReportPath & "rptAnnualBilling.pdf" As _
            zReportPath & "Bill" & Format(rst![[COLOR="#0000CD"]OwnerID[/COLOR]]) & ".pdf" [COLOR="#0000CD"]'*** Your field name here ***[/COLOR]
On Error GoTo 0
      
     rst.MoveNext        '*** Move to Next Record ***
   
   Loop Until rst.EOF
   
   MsgBox Format(lBillCnt, "#,###") & " Surveyor Reports Created.",  _
           vbOKOnly + vbInformation, _
           "Report Summary:"
   GoTo GetOut

WaitForPDFCreator:
   Select Case Err.Number
         Case 75
             Sleep 0.75  '*** Wait another 3/4 second. ***
             Resume Try_Again
         Case Else
             MsgBox "Module:" & vbTab & "BillingsCode" & vbCrLf & _
                    "Routine:" & vbTab & "EmailMailBills" & vbCrLf & _
                    "Error: " & Err.Number & " " & _
                    Err.Description, vbCritical + vbOKOnly, _
                    "Unexpected Error:"
             Resume GetOut
   End Select
   
GetOut:
   Set rst = Nothing     '*** Close RecordSet ***
   
   SwitchPrinters strDfltPrt
   
End Sub                   '*** EmailBills() ***

'                         +-------------------------+             +----------+
'-------------------------|   ClearPDFDirectory()   |-------------| 10/28/10 |
'                         +-------------------------+             +----------+
'Called By: EmailBills()
'Calls: N/A
'Purpose: Clear out directory so that the NAME command doesn't cause errors!

Sub ClearPDFDirectory()

   Dim zReportFN   As String
   Dim zReportPath As String
   
   zReportPath = zDBPath & "Reports"
   
   zReportFN = Dir(zReportPath & "*.pdf")
   
   Do Until zReportFN = ""
     Debug.Print zReportFN
     Kill zReportPath & zReportFN
     zReportFN = Dir()
   Loop
   
End Sub                 '*** ClearPDFDirectory() ***

'                          +---------------------+                 +----------+
'--------------------------|  SwitchPrinters()   |-----------------| 07/30/10 |
'                          +---------------------+                 +----------+
'Called by     : Report_Open()  - From any form!
'                Report_Close() - From any form!
'Calls         : N/A
'Function Calls: N/A
'Globals Used  : N/A

Sub SwitchPrinters(zSwitchToPtr As String)

  Dim prtName As Printer
  Dim iPrtNo  As Integer
  
  iPrtNo = 0
  
  For Each prtName In Application.Printers
     If prtName.DeviceName = zSwitchToPtr Then
       Exit For
     Else
       iPrtNo = iPrtNo + 1
     End If
  Next prtName

'*** Uncomment next 2 lines for testing or visual verification of switch ***
'  MsgBox "Printer Selected: " & Format(iPrtNo, "#0") & _
'         " " & Application.Printers(iPrtNo).DeviceName

  Application.Printer = Application.Printers(iPrtNo)

End Sub    '*** SwitchPrinters ***

I’ve included the subroutines that the main routine calls.

HTH :cheers:

May the Forces of good computing be with you!

RG

PowerShell & VBA Rule!
Computer Specs

Reply | Quote

RG, I keep getting a compile error at the following part of the code. strDfltPrt – I get ByRef Argument type mismatch. Any ideas?

Reply | Quote

Maria,

I don’t know of a way to get the output into .pdf format without a PDF printer and one that doesn’t present menus requiring user input for each instance to boot. I’m using Access 2010 and it’s capability to output to PDF is limited to a whole report there are no options to filter the report to only get one Surveyor per file.

How did you plan to get your output into PDF format?

:cheers:

May the Forces of good computing be with you!

RG

PowerShell & VBA Rule!
Computer Specs

Reply | Quote

I have just checked our system and we do have PDF Creator. I would only need to change the code to not send emails and just save each surveyor’s report as a separate PDF to a specified subdirectory, with the file name to include the Surveyor name and current date from the Surveyor field in the query.

Reply | Quote

Thanks, RG, I will try this out shortly and let you know how I get on.

Reply | Quote

As far as I recall from Access 2007 onwards you can output a report to PDF in the DoCmd.OpenReport command, it is specified by the type of output (acFormatPDF)

Reply | Quote

Maria,

Not enough code to tell which line containing that variable is causing problem.

You did include the SwitchPrinters() code in your project right?

Also you are sure PDFCreator is installed on the computer.

Here’s some info on configuring PDFCreator relating to this code.
43559-PDFCreator-Config.

HTH :cheers:

May the Forces of good computing be with you!

RG

PowerShell & VBA Rule!
Computer Specs

Reply | Quote

Thanks RG, Yes, I did include the SwitchPrinters() code in the project and PDF Creator is installed. I may need to get on to my IT department, as I cannot get into the PDF configuration file to make any changes. I will keep trying though.

Regards,
Maria.

Reply | Quote

Here’s how I do it. I keep a table with the SQL for each query. In the Where clause of each SQL, I stick something like “AND 0=0”. For example, your query would have this:

WHERE (((t_survey.survey_date) Is Null) AND ((t_survey.report_completed_date) Is Null)) AND 1=1

Prior to calling the report, I use the Replace function to replace “1=1” with whatever I want (like “Surveyor=12345”) and then replace the SQL in the query behind the report. In your case, I’d cycle through the Surveyor table and run the report for each Surveyor. This way, you can use the Output to PDF functionality within Access.

Reply | Quote

Here’s how I do it. I keep a table with the SQL for each query. In the Where clause of each SQL, I stick something like “AND 0=0”. For example, your query would have this:

WHERE (((t_survey.survey_date) Is Null) AND ((t_survey.report_completed_date) Is Null)) AND 1=1

Prior to calling the report, I use the Replace function to replace “1=1” with whatever I want (like “Surveyor=12345”) and then replace the SQL in the query behind the report. In your case, I’d cycle through the Surveyor table and run the report for each Surveyor. This way, you can use the Output to PDF functionality within Access.

Mark,

Can you give a little bit more detail on this, my Surveyor field is a concatenation of first_name and surname and is stored as text. In my SQL, this is the first part of the statement SELECT [t_surveyor]![first_name] & ” ” & [t_surveyor]![surname] AS Surveyor. How do I get it to loop through the Surveyor field in the query?

Reply | Quote

You could provide a surveyor in VBA then when use the WHERE in the OpenReport command.

Reply | Quote