Solved

PDF report based on recordset filter- not working! HELP

Posted on 2012-03-14
13
441 Views
Last Modified: 2012-03-15
In a member billing database, I have a table with all the member billing information.

I want to be able to print a report (which is an invoice) to a PDF file- one page per record. In other words, each PDF will be a single member's invoice for the past month.

What I have so far:
IN a module, I'm able to create a recordset based on the records for the month.

I am trying to apply a filter to that recordset and then use the filtered recordset as the report's recordsource.

However, when the code " DoCmd.OutputTo"  line below, it is actually printed a 16 page reports (number of records in recordset 'rst')

I've removed the reports recordsource from the 'front end' and added the following code:
Private Sub Report_Open(Cancel As Integer)
  Me.RecordSource = grstFiltered.Name
End Sub

but still all 16 records are in the PDF file!


Code:
Option Compare Database
Option Explicit


Public grstFiltered As DAO.Recordset


Public Function PrintReport()


    Dim dbs As DAO.Database
    Dim qdf As DAO.QueryDef
    Dim rst As DAO.Recordset
    Dim strSQL As String
    Dim strFN As String
    Dim strLN As String
   
    Dim strReportName As String
   
    Dim strNow As String

   On Error GoTo PrintReport_Error

Set dbs = CurrentDb

strSQL = "SELECT BillsNew.* FROM BillsNew WHERE (BillsNew.BillDate='Feb 2012');"

Set rst = dbs.OpenRecordset(strSQL)

rst.MoveLast
rst.MoveFirst


Do While Not rst.EOF

'Retrieve the name of the first Member in the selected recordset
strFN = rst.Fields("FirstName")
strLN = rst.Fields("LastName")
   
 
   
    'Now filter the Recordset to return only one member
    rst.Filter = "FirstName = '" & strFN & "' and LastName = '" & strLN & "'"

     Set grstFiltered = rst.OpenRecordset


    'Process the rows
    Do While Not grstFiltered.EOF
        strReportName = grstFiltered.Fields("LastName") & grstFiltered.Fields("FirstName")
        strNow = Format(Now, "yyyymmddhhMMss")
       
         DoCmd.OutputTo acOutputReport, "rptInvoice_New_PDF", acFormatPDF, "C:\Test\MemberINvoice" & strReportName & "_" & strNow & ".pdf"
        grstFiltered.MoveNext
    Loop

rst.MoveNext

Loop
 
  rst.Close
  Set rst = Nothing

   
grstFiltered.Close
Set grstFiltered = Nothing

   
    rst.Close
    dbs.Close
    Set rst = Nothing
    Set dbs = Nothing
   
   

   On Error GoTo 0
   Exit Function

PrintReport_Error:

    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure PrintReport of Module modPrinting"

End Function
0
Comment
Question by:scbdpm
  • 7
  • 4
  • 2
13 Comments
 
LVL 74

Expert Comment

by:Jeffrey Coachman
Comment Utility
(for me at least) A sample database would be easier to troubleshoot
Perhaps another expert can trouble shoot this with just your code though...

Sample database notes:
1. Back up your database(s).
2. Combine the front and back ends into one database file.
3. Remove any startup options, unless they are relevant to the issue.
4. Remove any records unless they are relevant to the issue.
5. Delete any objects that do not relate directly to the issue.
6. Remove any references to any "linked" files (files outside of the database, Images, OLE Files, ...etc)
7. Remove any references to any third party Active-x Controls (unless they are relevant to the issue)
8. Remove, obfuscate, encrypt, or otherwise disguise, any sensitive data.
9. Compile the code. (From the VBA code window, click: Debug-->Compile)
10. Run the compact/Repair utility.
11. Remove any Passwords and/or security.
12. If a form is involved in the issue, set the Modal and Popup properties to: No
    (Again, unless these properties are associated with the issue)
13. Post the explicit steps to replicate the issue.
14. Test the database before posting.

In other words, ...post a database that we can easily open and immediately see and/or troubleshoot the issue.
And if applicable, also include a clear graphical representation of the *Exact* results you are expecting, based on the sample data.

JeffCoachman
0
 

Author Comment

by:scbdpm
Comment Utility
Good Point Jeff

see attached
MemBilling.accdb
0
 
LVL 74

Expert Comment

by:Jeffrey Coachman
Comment Utility
First, I will say that your system here is "Un-normalized"
Repeating fields, Text "Dates", Cust info stored in the Invoice table, Fields with more than 1 piece of data, ...etc
I am not so sure it has to be as complex as you have made it...

All that aside, what if one person has more than one invoice in the month?
Is that more than one record/page or are the records to be "Grouped" by the customer.

I will post a simple example of what I believe to be a more straightforward approach.

In the mean time, I have no issue if another Expert wants to post a solution to this, keeping the DB as-is.

JeffCoachman
0
 
LVL 31

Expert Comment

by:Helen_Feddema
Comment Utility
Here is some code for creating a filtered PDF report for each member of a recordset (this is assuming, as others have mentioned, that your database is properly normalized):

Public Sub SendInterventionEmails()
'Created by Helen Feddema 10-Jan-2010
'Last modified by Helen Feddema 10-Jan-2010

On Error GoTo ErrorHandler

   Dim appOutlook As New Outlook.Application
   Dim itm As Outlook.MailItem
   Dim rstIntervention As DAO.Recordset
   Dim lngCount As Long
   Dim lngID As Long
   Dim rpt As Access.Report
   Dim strFileName As String
   Dim strPrompt As String
   Dim strQuery As String
   Dim strRecordSource As String
   Dim strReport As String
   Dim strSQL As String
   Dim strTitle As String
   Dim strCurrentPath As String
   Dim strFileNameAndPath As String
   Dim strEmailSource As String
   
   strEmailSource = "qryInterventionEmail"
   strRecordSource = "qryMissingAssignments"
   strQuery = "qryMissingAssignmentsSingleStudent"
   Set dbs = CurrentDb
   Set rstIntervention = dbs.OpenRecordset(strEmailSource)
   strCurrentPath = Application.CurrentProject.Path & "\"
   
   'Use path selected with SelectFolder procedure
   'strCurrentPath = SelectFolder()

   With rstIntervention
      Do While Not .EOF
         lngID = ![StID]
         Debug.Print "Processing Student ID " & lngID
         strFileName = "Intervention Report for " & ![StFirst] _
            & " " & ![StLast] & ".pdf"
         strFileNameAndPath = strCurrentPath & strFileName
         
         'Create filtered query
         strSQL = "SELECT * FROM " & strRecordSource & " WHERE " _
            & "[StID] = " & Chr(39) & lngID & Chr(39) & ";"
         Debug.Print "SQL for " & strQuery & ": " & strSQL
         lngCount = CreateAndTestQuery(strQuery, strSQL)
         Debug.Print "No. of items found: " & lngCount
         If lngCount = 0 Then
            GoTo NextStudent
         End If
      
         'Open report with filtered query record source
         strReport = "rptMissingAssignmentsNew"
         DoCmd.OpenReport ReportName:=strReport, _
            View:=acViewPreview, _
            windowmode:=acWindowNormal
         Set rpt = Reports(strReport)
         DoCmd.OutputTo objecttype:=acOutputReport, _
            objectname:=strReport, _
            outputformat:=acFormatPDF, _
            outputfile:=strFileNameAndPath
         
         'Create email
         Set itm = appOutlook.CreateItem(olMailItem)
         itm.Subject = "MISSING WORK"
         itm.Body = "The attached file lists your missing assignments"
         itm.To = ![Email]
         itm.Attachments.Add Source:=strFileNameAndPath, _
            Type:=olByValue
         
         'For editing before sending
         itm.Display
         
         'For sending automatically
         'itm.Send
         DoCmd.Close objecttype:=acReport, _
            objectname:=strReport, _
            Save:=acSaveNo

NextStudent:
         .MoveNext
      Loop
   End With
   
ErrorHandlerExit:
   Exit Sub

ErrorHandler:
   MsgBox "Error No: " & Err.Number _
      & " in SendInterventionEmails procedure; " _
      & "Description: " & Err.Description
   Resume ErrorHandlerExit

End Sub

Public Function CreateAndTestQuery(strTestQuery As String, _
   strTestSQL As String) As Long
'Created by Helen Feddema 28-Jul-2002
'Last modified by Helen Feddema 10-Jan-2010

On Error Resume Next
   
   'Delete old query
   Set dbs = CurrentDb
   dbs.QueryDefs.Delete strTestQuery

On Error GoTo ErrorHandler
   
   'Create new query
   Set qdf = dbs.CreateQueryDef(strTestQuery, strTestSQL)
   
   'Test whether there are any records
   Set rst = dbs.OpenRecordset(strTestQuery)
   With rst
      .MoveFirst
      .MoveLast
      CreateAndTestQuery = .RecordCount
   End With
   
ErrorHandlerExit:
   Exit Function

ErrorHandler:
   If Err.Number = 3021 Then
      CreateAndTestQuery = 0
      Resume ErrorHandlerExit
   Else
   MsgBox "Error No: " & Err.Number _
      & " in CreateAndTestQuery procedure; " _
      & "Description: " & Err.Description
   End If
   
End Function

Open in new window

0
 
LVL 74

Expert Comment

by:Jeffrey Coachman
Comment Utility
What version of Access are you using?
0
 
LVL 31

Expert Comment

by:Helen_Feddema
Comment Utility
Here is another (simpler) code sample:

Public Sub SendPDFEmails()
'Created by Helen Feddema 24-Jan-2010
'Last modified by Helen Feddema 24-Jan-2010

On Error GoTo ErrorHandler

   Dim appOutlook As New Outlook.Application
   Dim dbs As DAO.Database
   Dim lngCount As Long
   Dim lngEmployeeCount As Long
   Dim lngID As Long
   Dim msg As Outlook.MailItem
   Dim rpt As Access.Report
   Dim rstEmployees As DAO.Recordset
   Dim strAttachmentsPath As String
   Dim strBody As String
   Dim strEmployeeName As String
   Dim strEMailAddress As String
   Dim strPrompt As String
   Dim strQuery As String
   Dim strRecordSource As String
   Dim strReportFile As String
   Dim strReportName As String
   Dim strSQL As String
   Dim strSubject As String
   Dim strTitle As String
   
   strAttachmentsPath = GetProperty("AttachmentsPath", "") & "\"
   strSubject = GetProperty("MessageSubject", "Your custom report")
   strBody = GetProperty("MessageBody", "Your current report is attached as a PDF")
   strReportName = "rptEmployeeInvoices"
   Set dbs = CurrentDb
   Set rstEmployees = dbs.OpenRecordset("qryEMailEmployees")
   lngEmployeeCount = rstEmployees.RecordCount
   Debug.Print lngEmployeeCount & " employees need reports"

   If lngEmployeeCount = 0 Then
      strTitle = "No reports to send"
      strPrompt = "No employees need reports; canceling"
      MsgBox prompt:=strPrompt, _
         buttons:=vbExclamation + vbOKOnly, _
         Title:=strTitle
      GoTo ErrorHandlerExit
   End If
   
   Do While Not rstEmployees.EOF
      lngID = rstEmployees![EmployeeID]
      strEmployeeName = rstEmployees![Salesperson]
      strEMailAddress = rstEmployees![Email]
      strReportFile = strAttachmentsPath & "Employee Invoices" _
         & " for " & strEmployeeName & ".pdf"
      Debug.Print "PDF save name and path: " & strReportFile
      
      'Create filtered query as report record source
      strRecordSource = "qryInvoices"
      strQuery = "qryInvoicesPerEmployee"
      
      If lngID <> 0 Then
         strSQL = "SELECT * FROM " & strRecordSource & " WHERE " _
            & "[EmployeeID] = " & lngID & ";"
      End If
   
      Debug.Print "SQL for " & strQuery & ": " & strSQL
      lngCount = CreateAndTestQuery(strQuery, strSQL)
      
      'Output customized report to PDF
      DoCmd.OutputTo objecttype:=acOutputReport, _
         objectname:=strReportName, _
         outputformat:=acFormatPDF, _
         outputfile:=strReportFile, _
         autostart:=False
      
      'Create new mail message and send to employee
      Set msg = appOutlook.CreateItem(olMailItem)
      With msg
         .To = strEMailAddress
         .Subject = strSubject
         .Body = strBody
         .Attachments.Add strReportFile
         .Send
      End With
   
NextEmployee:
      rstEmployees.MoveNext
   Loop
   
   strTitle = "Done"
   strPrompt = lngEmployeeCount & " PDFs created and emailed"
   MsgBox prompt:=strPrompt, _
      buttons:=vbInformation + vbOKOnly, _
      Title:=strTitle

ErrorHandlerExit:
   Exit Sub

ErrorHandler:
   MsgBox "Error No: " & Err.Number _
      & " in SendPDFEmails procedure; " _
      & "Description: " & Err.Description
   Resume ErrorHandlerExit

End Sub

=======================
Public Function CreateAndTestQuery(strTestQuery As String, _
   strTestSQL As String) As Long
'Created by Helen Feddema 28-Jul-2002
'Last modified 6-Dec-2009

On Error Resume Next
   
   Dim qdf As DAO.QueryDef
   
   'Delete old query
   Set dbs = CurrentDb
   dbs.QueryDefs.Delete strTestQuery

On Error GoTo ErrorHandler
   
   'Create new query
   Set qdf = dbs.CreateQueryDef(strTestQuery, strTestSQL)
   
   'Test whether there are any records
   Set rst = dbs.OpenRecordset(strTestQuery)
   With rst
      .MoveFirst
      .MoveLast
      CreateAndTestQuery = .RecordCount
   End With
   
ErrorHandlerExit:
   Exit Function

ErrorHandler:
   If Err.Number = 3021 Then
      CreateAndTestQuery = 0
      Resume ErrorHandlerExit
   Else
   MsgBox "Error No: " & Err.Number _
      & " in CreateAndTestQuery procedure; " _
      & "Description: " & Err.Description
   End If
   
End Function

Open in new window

0
Comprehensive Backup Solutions for Microsoft

Acronis protects the complete Microsoft technology stack: Windows Server, Windows PC, laptop and Surface data; Microsoft business applications; Microsoft Hyper-V; Azure VMs; Microsoft Windows Server 2016; Microsoft Exchange 2016 and SQL Server 2016.

 
LVL 74

Accepted Solution

by:
Jeffrey Coachman earned 500 total points
Comment Utility
I will presume that you are using Access 2007(with the PDF add-in installed) or Access 2010 in my sample.
Database102.mdb
0
 

Author Comment

by:scbdpm
Comment Utility
Jeff
I am using Access 2010.

I totally agree, the database is not designed well. I didnt' plan to.
What I am trying to do with it is to suck in data given to me in a very poorly formatted Excel worksheet.

My job is to create PDF invoices to the members. I took the 'job' over in at the begining of the year and right now it is a very laborious, manually intensive, ridiculously ineffecient process.

I really don't plan to use the database for anything other than as a vehicle to get from the Excel worksheet to PDF invoices.

Part of the reason that I want to print one record (i.e. one member's invoice per report) is that I have to join the invoice to the PDF version of the minutes in order to send out.

again right now, I have to go through the Excel workseet taking a crazy version of the invoice, highlight the info for each indiviual member, PDF that then join this to the PDF of the minutes.... ridiculous!
0
 
LVL 74

Expert Comment

by:Jeffrey Coachman
Comment Utility
ok

I know that sometimes you have to build with the bricks you are given.

In any event, the sample I posted should still be applicable.
0
 

Author Comment

by:scbdpm
Comment Utility
Jeff- works like a charm...

the only thing I found was that you HAVE to preview the report before outputing it.

If you go right to output, it prints all records despite the WHERE clause!

Thank for the help!

I can't tell you how much tedious time this will save me!
0
 
LVL 74

Expert Comment

by:Jeffrey Coachman
Comment Utility
Yeah, there is a way around that, but the Preview approach is straightforward
0
 

Author Comment

by:scbdpm
Comment Utility
Jeff- this is likely another question I wil have to post but the next step in my process is to take the PDF invoice and then merge with the minutes.
THat document is then sent as a two page document to each member.

The email part may/may not be manual and I'm certain I can get that working.

Do you think the 'merge' or combine of the two PDFs is possible in Access?

I've done a search and come up with nothing.

I was also thinking that I could somehow get the Word doc into Access as the first page of the Invoice report. then the invoice report we worked on would be two pages and conquer that hurdle.,

thoughts?
0
 
LVL 74

Expert Comment

by:Jeffrey Coachman
Comment Utility
<Do you think the 'merge' or combine of the two PDFs is possible in Access?>
No, not in Access directly...

I believe that in the full version of Acrobat, you can do this....
There are also third party utilities that claim to be able to do this as well.
You can let Google be your guide for this...

You can insert the Word Doc into Access as an "Object", not really insert the Text.
This has it own set of complexities.

So a Merged PDF may be a better option.

Now, ...if the "Minutes" were in an Access table linked to the invoices in some way, that might be easier...
0

Featured Post

What Is Threat Intelligence?

Threat intelligence is often discussed, but rarely understood. Starting with a precise definition, along with clear business goals, is essential.

Join & Write a Comment

Introduction The Visual Basic for Applications (VBA) language is at the heart of every application that you write. It is your key to taking Access beyond the world of wizards into a world where anything is possible. This article introduces you to…
I see at least one EE question a week that pertains to using temporary tables in MS Access.  But surprisingly, I was unable to find a single article devoted solely to this topic. I don’t intend to describe all of the uses of temporary tables in t…
In Microsoft Access, learn different ways of passing a string value within a string argument. Also learn what a “Type Mis-match” error is about.
Access reports are powerful and flexible. Learn how to create a query and then a grouped report using the wizard. Modify the report design after the wizard is done to make it look better. There will be another video to explain how to put the final p…

771 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

14 Experts available now in Live!

Get 1:1 Help Now