Help saving incentive report as individual PDF at Supervisor Level

Question

0.00/5 (No votes)

See more:

I have an Access Report that is employee incentives. Each page is an individual employee's data. We are currently saving the entire report as PDF, then extracting the appropriate employees report into his/her supervisor's folder.

Supervisor Joe Dirt has 4 employees. We have to find his employees, extract from the PDF info a new PDF and save in Joe's folder.
Manual, painstaking process.

I've researched and came up with a code that sorta works, but not fully. It will take my list of supervisors and give them EACH a PDF with ALL the reports. (Report is 24 pages long, each supervisor gets the SAME EXACT 23 page report in their folder. Even if they aren't a supervisor in this area.)

I need help. I beleive I should be able to add a where statement that could/would refer to a hidden field on the report, which is the Sup_Sup_Name. I can't figure out the code.

Here is my code:

VB

Private Sub Command130_Click()
Dim rst As DAO.Recordset

Set rst = CurrentDb.OpenRecordset("SELECT DISTINCT [SUP_Sup_name] FROM [query03 Retail Lender] ORDER BY [SUP_Sup_name];", dbOpenSnapshot)

Do While Not rst.EOF
    strRptFilter = "[SUP_Sup_Name] = " & Chr(34) & rst![SUP_Sup_Name] & Chr(34)

    DoCmd.OutputTo acOutputReport, "Indv Retail Lender", acFormatPDF, "g:\data folder\data\incentive\" & "\" & rst![SUP_Sup_Name] & ".pdf"
    DoEvents
    rst.MoveNext
Loop

rst.Close
Set rst = Nothing
End Sub

Private Sub Report_Close()
strRptFilter = vbNullString
End Sub

Private Sub Report_Open(Cancel As Integer)
If Len(strRptFilter) <> 0 Then
     Me.Filter = strRptFilter
     Me.FilterOn = True
End If
End Sub

Posted 26-Apr-13 7:02am

kaskins77

Updated 26-Apr-13 7:03am

NotPolitcallyCorrect

v2

Add a Solution

1 solution

Add a Solution

Add your solution here

Treat my content as plain text, not as HTML

Preview 0

…

Existing Members

Sign in to your account

...or Join us

Download, Vote, Comment, Publish.

Your Email
Password
Forgot your password?

Your Email
This email is in use. Do you need your password?
Optional Password

I have read and agree to the Terms of Service and Privacy Policy
Please subscribe me to the CodeProject newsletters

When answering a question please:

Read the question carefully.
Understand that English isn't everyone's first language so be lenient of bad spelling and grammar.
If a question is poorly phrased then either ask for clarification, ignore it, or edit the question and fix the problem. Insults are not welcome.
Don't tell someone to read the manual. Chances are they have and don't get it. Provide an answer or move on to the next question.

Let's work to help developers, not make them feel stupid.

This content, along with any associated source code and files, is licensed under The Code Project Open License (CPOL)

Maciej Los · Answer 1 · 2013-04-26T08:11:00

You use DAO, so.. we can dynamically change query:

VB

Function ChangeQuery(sQryName As String, sSQL As String) As Boolean
Dim db As Database, qry As QueryDef

'default returned value
ChangeQuery = True

'ignore errors to check if query by given name exists
On Error Resume Next

Set qry = CurrentDb.QueryDefs(sQryName)
If Not qry is Nothing Then CurrentDb.Querydefs.Delete sQryName

'in case of deletion
CurrentDb.QueryDefs.Refresh

'catch errors
On Error GoTo Err_ChangeQuery

'add new query and refresh collection of queries
Set qry = CurrentDb.CreateQueryDef(sQryName, sSQL)
CurrentDb.QueryDefs.Refresh

Exit_ChangeQuery:
    On Error Resume Next
    qry.Close
    Set qry = Nothing
    db.close
    Set db = Nothing
    Exit Function

Err_ChangeQuery:
    Err.Clear
    ChangeQuery = False
    Resume Exit_ChangeQuery
End Function

Usage:

VB

Private Sub Command130_Click()
Dim rst As DAO.Recordset, bRetVal As Boolean, sSQL As String
 
Set rst = CurrentDb.OpenRecordset("SELECT DISTINCT [SUP_Sup_name] FROM [query03 Retail Lender] ORDER BY [SUP_Sup_name];", dbOpenSnapshot)
 
Do While Not rst.EOF
    sSQL = "SELECT * FROM SupEmployees WHERE [SUP_Sup_Name] = " & rst![SUP_Sup_Name]
    bRetVal  = ChangeQuery("Indv Retail Lender", sSQL)
    If bRetVal Then DoCmd.OutputTo acOutputReport, "Indv Retail Lender", acFormatPDF, "g:\data folder\data\incentive\" & "\" & rst![SUP_Sup_Name] & ".pdf"
    DoEvents
    rst.MoveNext
Loop
 
rst.Close
Set rst = Nothing
End Sub

Remove Private Sub Report_Close() and Private Sub Report_Open(Cancel As Integer) from Report.