Results 1 to 14 of 14
  1. #1
    Star Lounger
    Join Date
    Feb 2009
    Location
    Kings Park, Victoria, Australia
    Posts
    90
    Thanks
    15
    Thanked 5 Times in 5 Posts

    Access Report to multiple PDF Files

    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.
    Last edited by simmo7; 2016-02-09 at 19:50.
    Maria
    Simmo7
    Victoria, Australia

  2. #2
    Super Moderator RetiredGeek's Avatar
    Join Date
    Mar 2004
    Location
    Manning, South Carolina
    Posts
    9,434
    Thanks
    372
    Thanked 1,457 Times in 1,326 Posts
    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
    May the Forces of good computing be with you!

    RG

    PowerShell & VBA Rule!

    My Systems: Desktop Specs
    Laptop Specs

  3. #3
    Star Lounger
    Join Date
    Feb 2009
    Location
    Kings Park, Victoria, Australia
    Posts
    90
    Thanks
    15
    Thanked 5 Times in 5 Posts
    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?
    Maria
    Simmo7
    Victoria, Australia

  4. #4
    Super Moderator RetiredGeek's Avatar
    Join Date
    Mar 2004
    Location
    Manning, South Carolina
    Posts
    9,434
    Thanks
    372
    Thanked 1,457 Times in 1,326 Posts
    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?

    May the Forces of good computing be with you!

    RG

    PowerShell & VBA Rule!

    My Systems: Desktop Specs
    Laptop Specs

  5. #5
    Star Lounger
    Join Date
    Feb 2009
    Location
    Kings Park, Victoria, Australia
    Posts
    90
    Thanks
    15
    Thanked 5 Times in 5 Posts
    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.
    Maria
    Simmo7
    Victoria, Australia

  6. #6
    Super Moderator RetiredGeek's Avatar
    Join Date
    Mar 2004
    Location
    Manning, South Carolina
    Posts
    9,434
    Thanks
    372
    Thanked 1,457 Times in 1,326 Posts
    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   'The location of your .dbf file if split DB the BackEnd DB!
    
    '                         +-------------------------+             +----------+
    '-------------------------|      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 = "C:\Access\...\"   '*** Fully qualified path to your DB do not include file name ***
       zReportPath = zDBPath & "Reports\"
              
       ClearPDFDirectory
       strDfltPrt = Application.Printer.DeviceName
       SwitchPrinters "PDFCreator"
       
       Set dbName = CurrentDb()
       Set rst = dbName.OpenRecordset("Owners", dbOpenDynaset) '*** Your Table Name Here ***
       rst.MoveFirst
       
       lBillCnt = 0
    
       Do
          
           zWhere = "[OwnerID] = " & Str(rst![OwnerID]) '*** Modify w/your fields/selection criteria ***
       
    '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  '*** Your Report Name Here ***
       
    '******* 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![OwnerID]) & ".pdf" '*** Your field name here ***
    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
    May the Forces of good computing be with you!

    RG

    PowerShell & VBA Rule!

    My Systems: Desktop Specs
    Laptop Specs

  7. The Following User Says Thank You to RetiredGeek For This Useful Post:

    simmo7 (2016-02-09)

  8. #7
    Star Lounger
    Join Date
    Feb 2009
    Location
    Kings Park, Victoria, Australia
    Posts
    90
    Thanks
    15
    Thanked 5 Times in 5 Posts
    Thanks, RG, I will try this out shortly and let you know how I get on.
    Maria
    Simmo7
    Victoria, Australia

  9. #8
    Star Lounger
    Join Date
    Feb 2009
    Location
    Kings Park, Victoria, Australia
    Posts
    90
    Thanks
    15
    Thanked 5 Times in 5 Posts
    RG, I keep getting a compile error at the following part of the code. strDfltPrt - I get ByRef Argument type mismatch. Any ideas?
    Maria
    Simmo7
    Victoria, Australia

  10. #9
    Platinum Lounger
    Join Date
    Dec 2001
    Location
    Melbourne, Australia
    Posts
    4,594
    Thanks
    0
    Thanked 27 Times in 27 Posts
    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)

  11. #10
    Super Moderator RetiredGeek's Avatar
    Join Date
    Mar 2004
    Location
    Manning, South Carolina
    Posts
    9,434
    Thanks
    372
    Thanked 1,457 Times in 1,326 Posts
    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.
    PDFCreator Config.pdf.

    HTH
    May the Forces of good computing be with you!

    RG

    PowerShell & VBA Rule!

    My Systems: Desktop Specs
    Laptop Specs

  12. #11
    Star Lounger
    Join Date
    Feb 2009
    Location
    Kings Park, Victoria, Australia
    Posts
    90
    Thanks
    15
    Thanked 5 Times in 5 Posts
    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.
    Maria
    Simmo7
    Victoria, Australia

  13. #12
    Gold Lounger
    Join Date
    Jun 2001
    Location
    Crystal Beach, FL, Florida, USA
    Posts
    3,436
    Thanks
    1
    Thanked 34 Times in 34 Posts
    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 Liquorman
    See my website for Tips & Downloads and for my Liquorman Utilities.

  14. #13
    Star Lounger
    Join Date
    Feb 2009
    Location
    Kings Park, Victoria, Australia
    Posts
    90
    Thanks
    15
    Thanked 5 Times in 5 Posts
    Quote Originally Posted by MarkLiquorman View Post
    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?
    Maria
    Simmo7
    Victoria, Australia

  15. #14
    Platinum Lounger
    Join Date
    Dec 2001
    Location
    Melbourne, Australia
    Posts
    4,594
    Thanks
    0
    Thanked 27 Times in 27 Posts
    You could provide a surveyor in VBA then when use the WHERE in the OpenReport command.

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •