Solved

Export MS Access Report to Multiple PDF Files Based off of Employee Names

Posted on 2015-01-08
43
1,614 Views
Last Modified: 2016-02-12
I have some VBA Code to run reports (preview to screen).  There are parameters in the queries for these reports that use the information the user enters on the form as the criteria.  The reports pull all employee information for a specific manager.  So there might be several employees in the one report.

I would like to take these reports and instead of previewing on the screen I would like to export these reports to a PDF file, and since there might be more than one employee report, I would like the report to create separate PDF files for each employee.

I've included the VBA Code I currently have that previews the report to the screen.

How can this be accomplished?

Thanks,

gdunn59

Private Sub cmdEmpScorecardRptByDate_Click()
On Error GoTo Err_cmdEmpScorecardRptByDate_Click

Dim stDocName As String 

DoCmd.SetWarnings False 

If IsNull(Me.cboReportCateg) Or IsNull(Me.cboCategSelect) Then
    MsgBox "Please make selections from the drop-downs for an Auditor, Department, Employee or Manager", vbOKOnly

    Me.cboReportCateg.SetFocus
    Me.cboReportCateg.Dropdown

ElseIf Me.cboReportCateg = "Auditor" Then
    stDocName = "rptEmployee_Audit_Scorecard_ByAuditor"
    DoCmd.OpenReport stDocName, acPreview
    DoCmd.Maximize

ElseIf Me.cboReportCateg = "Department" Then
    stDocName = "rptEmployee_Audit_Scorecard_ByDept"
    DoCmd.OpenReport stDocName, acPreview
    DoCmd.Maximize

ElseIf Me.cboReportCateg = "Employee" Then
    stDocName = "rptEmployee_Audit_Scorecard_ByEmp"
    DoCmd.OpenReport stDocName, acPreview
    DoCmd.Maximize

ElseIf Me.cboReportCateg = "Region" Then
    stDocName = "rptEmployee_Audit_Scorecard_ByRegion"
    DoCmd.OpenReport stDocName, acPreview
    DoCmd.Maximize

ElseIf Me.cboReportCateg = "Manager" Then
    stDocName = "rptEmployee_Audit_Scorecard_ByMgr"
    DoCmd.OpenReport stDocName, acPreview
    DoCmd.Maximize

End If 

Exit_cmdEmpScorecardRptByDate_Click:

    Exit Sub 

Err_cmdEmpScorecardRptByDate_Click:

If Err.Number = 2501 Then   ' You cancelled .....

      ' no action required
Else
      MsgBox Err.Description

End If

Err.Clear

DoCmd.GoToControl "cboCategSelect"

Me.cboCategSelect = Null
Me.cboReportCateg = Null
Me.txtBeginDT = Null
Me.txtEndDT = Null
Me.cboDept = Null

GoTo Exit_cmdEmpScorecardRptByDate_Click

 DoCmd.SetWarnings True       

End Sub

Open in new window




Here is the SQL for one of the reports:
strRecordSetSQL = "SELECT tblEmployee_Audits.Employee, tblEmployee_Audits.Manager_Name, " & _
                    "tblEmployee_Audits.Quality_Review_Date, tblEmployee_Audits.Auditor_Name, " & _
                    "tblEmployee_Audits.Scorecard AS Audit_Type, tblEmployee_Audits.Department, " & _
                    "tblEmployee_Audits.Region, tblEmployee_Audits.System, tblEmployee_Audits.InquiryNum, " & _
                    "tblEmployee_Audits.Audit_Date, tblEmployee_Audits.Audit_Notes, tblEmployee_Audits.Audit_Status " & _
                    "FROM tblEmployee_Audits WHERE (((tblEmployee_Audits.Quality_Review_Date) Between Forms!frmReports!txtBeginDT And Forms!frmReports!txtEndDT) " & _
                    "And ((tblEmployee_Audits.Auditor_Name)=Forms!frmReports!cboCategSelect) And ((tblEmployee_Audits.Audit_Status)= " & Completed & ")) " & _
                    "Or (((tblEmployee_Audits.Auditor_Name)=Forms!frmReports!cboCategSelect) And ((tblEmployee_Audits.Audit_Status)=" & Completed & ") " & _
                    "And ((Forms!frmReports!txtBeginDT) Is Null));"

Open in new window

0
Comment
Question by:gdunn59
  • 25
  • 18
43 Comments
 
LVL 47

Expert Comment

by:Dale Fye (Access MVP)
ID: 40538889
To start with, I usually have a reports table, which contains fields like ReportName, ReportTitle, ReportDescription, and maybe another field that I can filter on, so that I only display certain reports in certain lists or combo boxes.

I then include the reportname and the reportTitle in the rowsource of the combo box or list and hide the reportName field.  Something like:

SELECT ReportTitle, ReportName from tblReports

That way, I don't have to have multiple IF statements in my code to identify which report to run.  I simply use code like:
strReportName = me.cboReport.Column(1)
DoCmd.OpenReport strReportName, acPreview
set rpt = Reports(strReportName)

Open in new window

Then, after I open the report in preview mode, I open a recordset of the employees.  I loop through this recordset and filter the report for each employee (this way I only have to run the report and the associated query once).
strSQL = "SELECT DISTINCT tblEmployee_Audits.Employee " & _
           "FROM tblEmployee_Audits WHERE (((tblEmployee_Audits.Quality_Review_Date) Between Forms!frmReports!txtBeginDT And Forms!frmReports!txtEndDT) " & _
                    "And ((tblEmployee_Audits.Auditor_Name)=Forms!frmReports!cboCategSelect) And ((tblEmployee_Audits.Audit_Status)= " & Completed & ")) " & _
                    "Or (((tblEmployee_Audits.Auditor_Name)=Forms!frmReports!cboCategSelect) And ((tblEmployee_Audits.Audit_Status)=" & Completed & ") " & _
                    "And ((Forms!frmReports!txtBeginDT) Is Null));"
set rsEmployees = currentdb.openrecordset(strSQL, , dbfailonerror)
While not rs.eof

    strFilter = "[Employee] = '" & rs!Employee & "'"
    rpt.filter = strFilter
    rpt.FilterOn = true
    strFileName = "C:\yourPath\" & Format(Date, "yyyy-mm-dd") & rs!Employee & ".PDF"
    docmd.outputto acOutputReport, rpt.name, acFormatPDF, strFileName
    rs.movenext
Wend
rs.close
set rs = nothing
docmd.close acReport, rpt.name

Open in new window

0
 

Author Comment

by:gdunn59
ID: 40539163
Dale,

I'm getting an error that there is too many parenthesis in the following code:

strSQL = "SELECT DISTINCT tblEmployee_Audits.Employee " & _
           "FROM tblEmployee_Audits WHERE (((tblEmployee_Audits.Quality_Review_Date) Between Forms!frmReports!txtBeginDT And Forms!frmReports!txtEndDT) " & _
                    "And ((tblEmployee_Audits.Auditor_Name)=Forms!frmReports!cboCategSelect) And ((tblEmployee_Audits.Audit_Status)= " & Completed & ")) " & _
                    "Or (((tblEmployee_Audits.Auditor_Name)=Forms!frmReports!cboCategSelect) And ((tblEmployee_Audits.Audit_Status)=" & Completed & ") " & _
                    "And ((Forms!frmReports!txtBeginDT) Is Null));"

Open in new window

0
 

Author Comment

by:gdunn59
ID: 40539190
Dale,

The error is:

  Extra ) in the query expression.

Thanks,
gdunn59
0
 
LVL 47

Expert Comment

by:Dale Fye (Access MVP)
ID: 40539261
That was basically your SQL, statement, but I'll take a stab at cleaning it up:

strSQL = "SELECT DISTINCT tblEmployee_Audits.Employee " _
  & "FROM tblEmployee_Audits " _
  & "WHERE (tblEmployee_Audits.Quality_Review_Date Between Forms!frmReports!txtBeginDT And Forms!frmReports!txtEndDT " _
  & " And tblEmployee_Audits.Auditor_Name = Forms!frmReports!cboCategSelect " _
  & " And tblEmployee_Audits.Audit_Status = " & Completed & ") " _
  & "Or " _
  & "(tblEmployee_Audits.Auditor_Name = Forms!frmReports!cboCategSelect " _
  & " And tblEmployee_Audits.Audit_Status = " & Completed _
  & " And Forms!frmReports!txtBeginDT Is Null);"

Open in new window

0
 

Author Comment

by:gdunn59
ID: 40539287
Dale,

Ok.  the last one you posted wasn't the cleaned up one, correct?

Thanks,
gdunn59
0
 
LVL 47

Expert Comment

by:Dale Fye (Access MVP)
ID: 40540036
The last one I posted is a cleaned up version.
0
 

Author Comment

by:gdunn59
ID: 40540489
Dale,

I'm still getting the same error about the parenthesis.

Thanks,
gdunn59
0
 

Author Comment

by:gdunn59
ID: 40540752
Dale,

I just don't understand it.  The cursor is actually stopping on the next line after the SQL statement on:

Set rsEmployees = CurrentDb.OpenRecordset(strSQL, , dbFailOnError)

I can't figure out why it is saying there is an extra ).  I've deleted all of the parenthesis then I get that there is a missing operator.

Any clues?

Thanks,
gdunn59
0
 
LVL 47

Expert Comment

by:Dale Fye (Access MVP)
ID: 40541019
OK, so try this.

Insert a line before the SET rsEmployees line:

debug.print strSQL

Then put a breakpoint on the Set rsEmployees line.

When you run the code, copy the SQL string that is show in the debug window and paste it into a SQL query and attempt to run the SQL.  You might also post it here so I can see how it is being interpreted.  I don't generally leave the references to forms inside the quotes when I build strSQL, I normally do the following, which actually embeds the values of those form controls into the SQL.

strSQL = "SELECT DISTINCT tblEmployee_Audits.Employee " _
  & "FROM tblEmployee_Audits " _
  & "WHERE (tblEmployee_Audits.Quality_Review_Date Between #" & Forms!frmReports!txtBeginDT & "# And #" & Forms!frmReports!txtEndDT & "# " _
  & " And tblEmployee_Audits.Auditor_Name = '" & Forms!frmReports!cboCategSelect & "' " _
  & " And tblEmployee_Audits.Audit_Status = " & Completed & ") " _
  & "Or " _
  & "(tblEmployee_Audits.Auditor_Name = '" & Forms!frmReports!cboCategSelect & "' " _
  & " And tblEmployee_Audits.Audit_Status = " & Completed _
  & " And " & NZ(Forms!frmReports!txtBeginDT, #1/1/2000#) & " = #1/1/2000#);"

Open in new window

 I find that this method lets me debug the SQL String better because I can actually see what the SQL string looks like with the values that are retrieved from the form.
0
 

Author Comment

by:gdunn59
ID: 40541110
Dale,

First off, I entered a line before the SET rsEmployees line, and typed in debug.print strSQL, and then I put a breakpoint on the Set rsEmployees line, but it never gets to the debug.print line because of the error.

Here is my code with the debug.print strSQL (did I put it in the right place)?

Private Sub cmdEmpScorecardRptByMgr_Click()
'On Error GoTo Err
'-----------------------------------
'Variables
'-----------------------------------
Dim StrEmployee As String
Dim db As DAO.Database
Dim qdf As DAO.QueryDef
Dim strQuery As String
Dim strReportName As String
Dim rs As DAO.Recordset             'shortens record set call
Dim strRecordSetSQL As String       'record set string to pass to SQL
Dim strPath As String
Dim strDate As String
Dim strSQL As String
                    
strSQL = "SELECT DISTINCT tblEmployee_Audits.Employee " _
  & "FROM tblEmployee_Audits " _
  & "WHERE (tblEmployee_Audits.[Quality_Review_Date] Between Forms!frmReports![txtBeginDT] And Forms!frmReports![txtEndDT] " _
  & " And tblEmployee_Audits.[Manager_Name] = Forms!frmReports![cboCategSelect] " _
  & " And tblEmployee_Audits.[Audit_Status] = " & Completed & ") " _
  & "Or " _
  & "(tblEmployee_Audits.[Manager_Name] = Forms!frmReports![cboCategSelect] " _
  & " And tblEmployee_Audits.[Audit_Status] = " & Completed & ") " _
  & " And Forms!frmReports![txtBeginDT] Is Null);"
  

Set rsEmployees = CurrentDb.OpenRecordset(strSQL, , dbFailOnError)

While Not rs.EOF

    strFilter = "[Employee] = '" & rs!Employee & "'"
    rpt.Filter = strFilter
    rpt.FilterOn = True
    strFileName = "strPath\" & Format(Date, "yyyy-mm-dd") & rs!Employee & ".PDF"
    DoCmd.OutputTo acOutputReport, rpt.Name, acFormatPDF, strFileName
    rs.MoveNext
Wend
rs.Close
Set rs = Nothing
DoCmd.Close acReport, rpt.Name

MsgBox ("Reports Created")

End Sub

Open in new window


Also, I dumped the SQL into a SQL Query and cleaned it up for SQL, and then ran it and I didn't get any errors.  Here is my SQL Query:

use [OPS_EmployeeAuditScorecardSystem]

 SELECT DISTINCT Employee, Manager_Name
 FROM tblEmployee_Audits
 WHERE (tblEmployee_Audits.[Quality_Review_Date] Between '12/01/2014' And '12/31/2014'
 And tblEmployee_Audits.[Manager_Name] = 'Miller, Karen'
 And tblEmployee_Audits.[Audit_Status] = 'Completed'
 Or tblEmployee_Audits.[Manager_Name] = 'Miller, Karen'
 And tblEmployee_Audits.[Audit_Status] = 'Completed'
 And tblEmployee_Audits.[Quality_Review_Date] Is Null);
 go

Open in new window

0
 

Author Comment

by:gdunn59
ID: 40541173
Sorry, I removed the debug statement.  Here is the code with it:



Private Sub cmdEmpScorecardRptByMgr_Click()
'On Error GoTo Err
'-----------------------------------
'Variables
'-----------------------------------
Dim StrEmployee As String
Dim db As DAO.Database
Dim qdf As DAO.QueryDef
Dim strQuery As String
Dim strReportName As String
Dim rs As DAO.Recordset             'shortens record set call
Dim strRecordSetSQL As String       'record set string to pass to SQL
Dim strPath As String
Dim strDate As String
Dim strSQL As String
                    
strSQL = "SELECT DISTINCT tblEmployee_Audits.Employee " _
  & "FROM tblEmployee_Audits " _
  & "WHERE (tblEmployee_Audits.[Quality_Review_Date] Between Forms!frmReports![txtBeginDT] And Forms!frmReports![txtEndDT] " _
  & " And tblEmployee_Audits.[Manager_Name] = Forms!frmReports![cboCategSelect] " _
  & " And tblEmployee_Audits.[Audit_Status] = " & Completed & ") " _
  & "Or " _
  & "(tblEmployee_Audits.[Manager_Name] = Forms!frmReports![cboCategSelect] " _
  & " And tblEmployee_Audits.[Audit_Status] = " & Completed & ") " _
  & " And Forms!frmReports![txtBeginDT] Is Null);"
  
debug.print strSQL

Set rsEmployees = CurrentDb.OpenRecordset(strSQL, , dbFailOnError)

While Not rs.EOF

    strFilter = "[Employee] = '" & rs!Employee & "'"
    rpt.Filter = strFilter
    rpt.FilterOn = True
    strFileName = "strPath\" & Format(Date, "yyyy-mm-dd") & rs!Employee & ".PDF"
    DoCmd.OutputTo acOutputReport, rpt.Name, acFormatPDF, strFileName
    rs.MoveNext
Wend
rs.Close
Set rs = Nothing
DoCmd.Close acReport, rpt.Name

MsgBox ("Reports Created")

End Sub

Open in new window

0
 
LVL 47

Expert Comment

by:Dale Fye (Access MVP)
ID: 40541309
OK, lets do this one step at a time, and focus on getting the list of employees.

1.  What does the result set of the reports recordsource (the query used by the report) look like?  Is there only one record per employee, or do you have multiple records and are doing some form of Grouping in the report on the [Employee] field?

2.  Let's clean this up a little and focus on getting a recordset which works.  Is the [Audit_Status] field a text field?  Do you want to test that value against the variable named "Completed", or do you want to test that against the actual value "Completed"?  I've rewritten the code below to assume you want to test the value for the value of that field = "Completed".

Does the following work:

Private Sub cmdEmpScorecardRptByMgr_Click()
On Error GoTo  ProcError
'-----------------------------------
'Variables
'-----------------------------------
Dim rs As DAO.Recordset
Dim strSQL As String
                    
     strSQL = "SELECT DISTINCT tblEmployee_Audits.Employee " _
  & "FROM tblEmployee_Audits " _
  & "WHERE (tblEmployee_Audits.[Quality_Review_Date] Between #" _
  & Forms!frmReports![txtBeginDT] & "# And #" _
  & Forms!frmReports![txtEndDT] & "# " _
  & " And tblEmployee_Audits.[Manager_Name] = '" & Forms!frmReports![cboCategSelect] & "' " _
  & " And tblEmployee_Audits.[Audit_Status] = 'Completed') "

debug.print strSQL

Set rs = CurrentDb.OpenRecordset(strSQL, , dbFailOnError)

While Not rs.EOF

    strFilter = "[Employee] = '" & rs!Employee & "'"
    debug.print strFilter

    rs.MoveNext
Wend

MsgBox ("Done")
ProcExit:
On Error Resume Next
rs.Close
Set rs = Nothing

Exit Sub

ProcError:
msgbox err.number & vbcrlf & err.description, , "Scorecard Click"
debug.print "Scorecard Click", err.number, err.description
Resume ProcExit

End Sub

Open in new window

If this works, we will move on the fixing the 2nd part of the WHERE clause.If not, post the text of strSQL that gets written to the debug window, or the text of the error message if it gets to that.

When you test this, make sure that the Begin/End date fields are filled in.
0
 
LVL 47

Expert Comment

by:Dale Fye (Access MVP)
ID: 40541315
BTW, what backend database are you using?  SQL Server, MySQL, ???

I just noticed that in your sample SQL, you use dates like '12/01/2014',  This is not an Access syntax, because dates in Access must be wrapped in #, as in #12/01/2014#, so the syntax I posted above is likely to generate an error unless the table is linked to Access.
0
 

Author Comment

by:gdunn59
ID: 40541353
Dale,

Great that last posting worked.

So I went ahead and tried pasting in the code from your other posting to get it to separate the reports into individual PDF files based off the Employee, but I'm getting a "424 - Object Required" error.  The error is occuring when it gets to this line of code "rpt.Filter = strFilter".

Here is my code:

Private Sub cmdEmpScorecardRptByMgr_Click()
On Error GoTo ProcError
'-----------------------------------
'Variables
'-----------------------------------
Dim rs As DAO.Recordset
Dim strSQL As String
Dim strFilter As String
Dim strPath As String
                    
strSQL = "SELECT DISTINCT tblEmployee_Audits.Employee " _
  & "FROM tblEmployee_Audits " _
  & "WHERE (tblEmployee_Audits.[Quality_Review_Date] Between #" _
  & Forms!frmReports![txtBeginDT] & "# And #" _
  & Forms!frmReports![txtEndDT] & "# " _
  & " And tblEmployee_Audits.[Manager_Name] = '" & Forms!frmReports![cboCategSelect] & "' " _
  & " And tblEmployee_Audits.[Audit_Status] = 'Completed') "

Debug.Print strSQL

Set rs = CurrentDb.OpenRecordset(strSQL, , dbFailOnError)

strPath = "C:\Users\ab56446\Desktop\Adam Mallord\Network Version of Databases\2011_Promised Apps\App Count Database from Diane (10-2014)\Reports\"

While Not rs.EOF

 strFilter = "[Employee] = '" & rs!Employee & "'"
    rpt.Filter = strFilter
    rpt.FilterOn = True
    strFileName = "strPath " & Format(Date, "yyyy-mm-dd") & rs!Employee & ".PDF"
    DoCmd.OutputTo acOutputReport, rpt.Name, acFormatPDF, strFileName
    rs.MoveNext
Wend
rs.Close
Set rs = Nothing
DoCmd.Close acReport, rpt.Name

MsgBox ("Done")
ProcExit:
On Error Resume Next
rs.Close
Set rs = Nothing

Exit Sub

ProcError:
MsgBox Err.Number & vbCrLf & Err.Description, , "Scorecard Click"
Debug.Print "Scorecard Click", Err.Number, Err.Description
Resume ProcExit

End Sub

Open in new window

0
 
LVL 47

Expert Comment

by:Dale Fye (Access MVP)
ID: 40541381
That is because you never opened the report and set the rpt object to that report.  You need to add:

Dim strReportName as string
Dim rpt as Report

strReportName = me.cboReport.Column(1)
DoCmd.OpenReport strReportName, acPreview
set rpt = Reports(strReportName)

Open in new window

at the beginning of the code, between your last DIM statement and the strSQL = line.

The SQL in that code I just sent you only has the first part of your where clause.  We need to tweak that to address the condition where txtBeginDT IS NULL.  I'm on my way out the door, but will revisit this later this evening.
0
 

Author Comment

by:gdunn59
ID: 40541385
Ok.  Thank you.

I'll let you know what happens.

gdunn59
0
 

Author Comment

by:gdunn59
ID: 40541548
Dale,

Ok.  I got it working somewhat.  The problem still is it isn't separating the reports into indivdual PDF files.  It creates 8 different reports, but each report contains all the employees in one report.

I was a little confused on your posting about the table with the reports, so I just hard coded the one report for now.

Here is the code I'm using:

Private Sub cmdEmpScorecardRptByMgr_Click()
On Error GoTo ProcError
'-----------------------------------
'Variables
'-----------------------------------
Dim rs As DAO.Recordset
Dim strSQL As String
Dim strFilter As String
                    
strSQL = "SELECT DISTINCT tblEmployee_Audits.Employee " _
  & "FROM tblEmployee_Audits " _
  & "WHERE (tblEmployee_Audits.[Quality_Review_Date] Between #" _
  & Forms!frmReports![txtBeginDT] & "# And #" _
  & Forms!frmReports![txtEndDT] & "# " _
  & " And tblEmployee_Audits.[Manager_Name] = '" & Forms!frmReports![cboCategSelect] & "' " _
  & " And tblEmployee_Audits.[Audit_Status] = 'Completed') "

Debug.Print strSQL

Set rs = CurrentDb.OpenRecordset(strSQL, , dbFailOnError)

Dim strPath As String
'strPath = "https://collaborate.wellpoint.com/sites/MGRM/Quality%20Reports/Forms/AllItems.aspx?RootFolder=%2Fsites%2FMGRM%2FQuality%20Reports%2FEGR%20Rpts%2FEGR%20Associate%20Reports\"
strPath = "C:\Users\ab56446\Desktop\Adam Mallord\Network Version of Databases\2011_Promised Apps\App Count Database from Diane (10-2014)\Reports\"

Dim strReportName As String
Dim rpt As Report

'strReportName = Me.cboReport.Column(1)

strReportName = "rptEmployee_Audit_Scorecard_ByMgr"
DoCmd.OpenReport strReportName, acPreview
Set rpt = Reports(strReportName)

While Not rs.EOF

 strFilter = "[Employee] = '" & rs!Employee & "'"
    rpt.Filter = strFilter
    rpt.FilterOn = True
    strFileName = strPath & Format(Date, "yyyy-mm-dd") & rs!Employee & ".PDF"
    DoCmd.OutputTo acOutputReport, rpt.Name, acFormatPDF, strFileName
    rs.MoveNext
Wend


rs.Close
Set rs = Nothing
DoCmd.Close acReport, rpt.Name

MsgBox ("Done")
ProcExit:
On Error Resume Next
rs.Close
Set rs = Nothing

Exit Sub

ProcError:
MsgBox Err.Number & vbCrLf & Err.Description, , "Scorecard Click"
Debug.Print "Scorecard Click", Err.Number, Err.Description
Resume ProcExit

End Sub

Open in new window

0
 

Author Comment

by:gdunn59
ID: 40541575
Dale,

Ok.  It worked for a minute.  It created 4 separate reports, and then with the next Employee, it continued to create the reports with the correct Employee in the name of the Report, but when I opened the reports they contained the same information as the 4th report for the remainder of the reports.

Any suggestions?

Thanks,

gdunn59
0
 
LVL 47

Expert Comment

by:Dale Fye (Access MVP)
ID: 40542330
Very strange, that technique works for me all of the time.  If you put a breakpoint on the line after:

me.filteron = true

do you see the filter take effect in the report that is in print preview?

While we are at it, lets replace the sql string with:

strSQL = "SELECT DISTINCT tblEmployee_Audits.Employee " _
  & "FROM tblEmployee_Audits " _
  & "WHERE ([Manager_Name] = '" & Forms!frmReports![cboCategSelect] & "' " _
  & " And [Audit_Status] = 'Completed') "

if Forms!frmReports!txtBeginDT & "" = "" Then
    'don't add anything to the SQL, if BeginDT is NULL, then select all employees
    'for the selected manager where status is "Completed"
Elseif Forms!frmReports![txtEndDT] & "" = "" Then
    strSQL = strSQL & " AND [Quality_Review_Date] >= #" _
        & Forms!frmReports![txtBeginDT] & "#"
Else
    strSQL = strSQL & " AND [Quality_Review_Date] Between #" _
        & Forms!frmReports![txtBeginDT] & "# And #" _
        & Forms!frmReports![txtEndDT] & "# "
endif

Open in new window

I added a 2nd test here to test for an empty txtEndDT.  You could change that SQL as appropriate, but if you don't have that test and that control is empty, then the "Else" portion of the If/Then/Else will cause an error.
0
 

Author Comment

by:gdunn59
ID: 40542424
Dale,

Your code you posted had rpt.filteron = true not me.filteron = true.

Should it be me.filteron?
0
 
LVL 47

Expert Comment

by:Dale Fye (Access MVP)
ID: 40542433
sorry, should be rpt.filteron
0
IT, Stop Being Called Into Every Meeting

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

 

Author Comment

by:gdunn59
ID: 40542466
Ok.  That's what I got.

I'll do the breakpoint on the line after rpt.filteron = true and see what happens.

I'll let you know.

Thanks,

gdunn59
0
 

Author Comment

by:gdunn59
ID: 40542505
It was putting the correct names and processed all the reports.  There are 9 different employee's for the report, everything ran ok until it got to the 9th/final report, then it had the correct name of the employee in the report filename, but the report contained data for the 8th employee/report.

I can't figure out why this is happening.

Any suggestions?

Thanks,

gdunn59
0
 
LVL 47

Expert Comment

by:Dale Fye (Access MVP)
ID: 40542538
Do you still have the

debug.print strFilter

line in the code?  If not, add that back in and try it again to see what that says the filter is supposed to be for each of the records.  Is there a chance that you have more than one employee with the same [Employee] field value?
0
 

Author Comment

by:gdunn59
ID: 40542570
The problem is it is saving all 287 pages of the report for each employee, with the correct PDF Employee filenames, but it's not separating the reports.  It'll run and creates the correct individual PDFs for some of the reports, but then it starts creating the individual PDF's with the correct Employee PDF Filenames, but they contain all the pages of the entire report.  If I get out of it and run it again, then it is creating the individual Employee PDF Filenames, but every single one of the separate reports contain all the pages of the entire report for everyone.  

I'm puzzled.

What version of Windows/MS Office are you using?  I'm using Windows 7 and Office 2010.

Thanks,
gdunn59
0
 
LVL 47

Expert Comment

by:Dale Fye (Access MVP)
ID: 40542587
The test I did earlier today was on Win 7 with Office 2007.  Worked fine for the simple test I did.  And I have users running the application I tested on Win 7 with Office 2010 and they have not reported any errors.

You might want to add  a line right before the OutputTo line:

if dir(strFileName) <> "" then Kill strFileName

This will delete that file if it already exists.
0
 
LVL 47

Expert Comment

by:Dale Fye (Access MVP)
ID: 40542600
What version of Office 2010 are you using (32 bit or 64 bit)?
0
 

Author Comment

by:gdunn59
ID: 40542604
How do I find the Office 2010 information you asked about?

Thanks,
gdunn59
0
 

Author Comment

by:gdunn59
ID: 40542644
It's just not consistent.  I put in the line to Kill the report if it already exists and ran the process again.  It created all 9 individual reports.  The first 4 reports were fine, then the 5th-9th reports all had the 5th employee's data in the report, but the report names were for each individual employee.

The debug.print shows all the correct names.

I don't know what to think about this, it's strange.

Anymore suggestions?

Thanks,
gdunn
0
 
LVL 47

Expert Comment

by:Dale Fye (Access MVP)
ID: 40543040
Yes, I spoke with several friends and one recommended putting a delay in the loop between after the OutputTo command.  To do so, add the following code to a regular code module, not a forms code module, just that one line

Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)

Then insert this line (you may have to play with the duration - 1000 = 1 second) before the OutputTo command

Sleep 3000

She indicates that she has seen this problem before with OutputTo and TransferText methods, and that adding the delay seems to allow access to complete the previous process, especially in loops like this.
0
 

Author Comment

by:gdunn59
ID: 40543764
Dale,

I've tried putting in the new module for the Sleep command, and entered the Sleep 3000, also tried it with 6000.  Also, closed out the database and got back in, did a compact and repair several times and ran it again, still doing the same thing.

Here is the complete code I'm using:

Private Sub cmdEmpScorecardRptByMgr_Click()
On Error GoTo ProcError
'-----------------------------------
'Variables
'-----------------------------------
Dim rs As DAO.Recordset
Dim strSQL As String
Dim strFilter As String
                    
strSQL = "SELECT DISTINCT tblEmployee_Audits.Employee " _
  & "FROM tblEmployee_Audits " _
  & "WHERE ([Manager_Name] = '" & Forms!frmReports![cboCategSelect] & "' " _
  & " And [Audit_Status] = 'Completed') "

If Forms!frmReports!txtBeginDT & "" = "" Then
    'don't add anything to the SQL, if BeginDT is NULL, then select all employees
    'for the selected manager where status is "Completed"
ElseIf Forms!frmReports![txtEndDT] & "" = "" Then
    strSQL = strSQL & " AND [Quality_Review_Date] >= #" _
        & Forms!frmReports![txtBeginDT] & "#"
Else
    strSQL = strSQL & " AND [Quality_Review_Date] Between #" _
        & Forms!frmReports![txtBeginDT] & "# And #" _
        & Forms!frmReports![txtEndDT] & "# "
End If

Debug.Print strSQL

Set rs = CurrentDb.OpenRecordset(strSQL, , dbFailOnError)

Dim strPath As String

strPath = "C:\Users\ab56446\Desktop\Adam Mallord\Network Version of Databases\Audit_Database\SQL Version\Reports\"

Dim strReportName As String
Dim rpt As Report

'strReportName = Me.cboReport.Column(1)

strReportName = "rptEmployee_Audit_Scorecard_ByMgr"
DoCmd.OpenReport strReportName, acPreview
Set rpt = Reports(strReportName)

While Not rs.EOF
'Do While Not rs.EOF
 strFilter = "[Employee] = '" & rs!Employee & "'"
    rpt.Filter = strFilter
    rpt.FilterOn = True
    
    Debug.Print strFilter
    
    strFileName = strPath & Format(Date, "yyyy-mm-dd") & rs!Employee & ".PDF"
    
    If Dir(strFileName) <> "" Then Kill strFileName

    Sleep 6000
    
    DoCmd.OutputTo acOutputReport, rpt.Name, acFormatPDF, strFileName, False
    rs.MoveNext
Wend
'Loop

rs.Close
Set rs = Nothing
DoCmd.Close acReport, rpt.Name

MsgBox ("Done")
ProcExit:
On Error Resume Next
rs.Close
Set rs = Nothing

Exit Sub

ProcError:
MsgBox Err.Number & vbCrLf & Err.Description, , "Scorecard Click"
Debug.Print "Scorecard Click", Err.Number, Err.Description
Resume ProcExit

End Sub

Open in new window


Any more suggestions?

Thanks,

gdunn59
0
 
LVL 47

Expert Comment

by:Dale Fye (Access MVP)
ID: 40544886
gdunn,

OK, here is another alternative.  This will create the recordset of employees, and then open the report using the WHERE argument defined by the employee loop.  It will then output that report and close it, before the next employee

Private Sub cmdEmpScorecardRptByMgr_Click()
On Error GoTo ProcError
'-----------------------------------
'Variables
'-----------------------------------
Dim rs As DAO.Recordset
Dim strSQL As String
Dim strWhere As String
Dim strPath As String
Dim strReportName As String
     
strSQL = "SELECT DISTINCT tblEmployee_Audits.Employee " _
  & "FROM tblEmployee_Audits " _
  & "WHERE ([Manager_Name] = '" & Forms!frmReports![cboCategSelect] & "' " _
  & " And [Audit_Status] = 'Completed') "

If Forms!frmReports!txtBeginDT & "" = "" Then
    'don't add anything to the SQL, if BeginDT is NULL, then select all employees
    'for the selected manager where status is "Completed"
ElseIf Forms!frmReports![txtEndDT] & "" = "" Then
    strSQL = strSQL & " AND [Quality_Review_Date] >= #" _
        & Forms!frmReports![txtBeginDT] & "#"
Else
    strSQL = strSQL & " AND [Quality_Review_Date] Between #" _
        & Forms!frmReports![txtBeginDT] & "# And #" _
        & Forms!frmReports![txtEndDT] & "# "
End If

Debug.Print strSQL

Set rs = CurrentDb.OpenRecordset(strSQL, , dbFailOnError)

strPath = "C:\Users\ab56446\Desktop\Adam Mallord\Network Version of Databases\Audit_Database\SQL Version\Reports\"

'strReportName = Me.cboReport.Column(1)

strReportName = "rptEmployee_Audit_Scorecard_ByMgr"

While Not rs.EOF
    strWhere = "[Employee] = '" & rs!Employee & "'"
    Debug.Print strWhere
    DoCmd.OpenReport strReportName, acPreview, , strWhere

    strFileName = strPath & Format(Date, "yyyy-mm-dd") & rs!Employee & ".PDF"
    If Dir(strFileName) <> "" Then Kill strFileName
    DoCmd.OutputTo acOutputReport, strRptName, acFormatPDF, strFileName, False
    docmd.close acReport, strRptName

    rs.MoveNext
Wend

MsgBox ("Done")

ProcExit:
On Error Resume Next
rs.Close
Set rs = Nothing
Exit Sub

ProcError:
MsgBox Err.Number & vbCrLf & Err.Description, , "Scorecard Click"
Debug.Print "Scorecard Click", Err.Number, Err.Description
Resume ProcExit

End Sub

Open in new window

0
 

Author Comment

by:gdunn59
ID: 40545002
Dale,

I tried you last posting of code, and it created the very first employee report, but then when it loops back through it shows the strWhere for the next employee but it doesn't show anything for that next employee.  I get the message that there are no records found for that Manager, and then I get the error "2501 The OpenReport action was canceled".

?????

Thanks,

gdunn59
0
 
LVL 47

Expert Comment

by:Dale Fye (Access MVP)
ID: 40545076
I don't understand why you would get a message indicating that there are no records for that manager, when the SQL statement that is selecting records for the employee is already filtering on the Manager = Forms!frmReports![cboCategSelect].

Can you create a new database, import this form, and the appropriate report and table into the new database, and post that here?

If you do this, you will need to purge any proprietary or personal information from the table.  I would simply write an update query in this new sample database and change all of the fields that are not relevant to NULL.
0
 
LVL 47

Expert Comment

by:Dale Fye (Access MVP)
ID: 40545100
It could be that the query that is the record source for the report is sufficiently different than the query we are using in this code that we are actually returning employees names that are not available in the actual report.  In that case, you need to add an error handler that will move to the next employee in the recordset if that situation occurs.  I've added a line reference (inside the loop) and a couple of lines to the error handler in the code below:
Private Sub cmdEmpScorecardRptByMgr_Click()
On Error GoTo ProcError
'-----------------------------------
'Variables
'-----------------------------------
Dim rs As DAO.Recordset
Dim strSQL As String
Dim strWhere As String
Dim strPath As String
Dim strReportName As String
     
strSQL = "SELECT DISTINCT tblEmployee_Audits.Employee " _
  & "FROM tblEmployee_Audits " _
  & "WHERE ([Manager_Name] = '" & Forms!frmReports![cboCategSelect] & "' " _
  & " And [Audit_Status] = 'Completed') "

If Forms!frmReports!txtBeginDT & "" = "" Then
    'don't add anything to the SQL, if BeginDT is NULL, then select all employees
    'for the selected manager where status is "Completed"
ElseIf Forms!frmReports![txtEndDT] & "" = "" Then
    strSQL = strSQL & " AND [Quality_Review_Date] >= #" _
        & Forms!frmReports![txtBeginDT] & "#"
Else
    strSQL = strSQL & " AND [Quality_Review_Date] Between #" _
        & Forms!frmReports![txtBeginDT] & "# And #" _
        & Forms!frmReports![txtEndDT] & "# "
End If

Debug.Print strSQL

Set rs = CurrentDb.OpenRecordset(strSQL, , dbFailOnError)

strPath = "C:\Users\ab56446\Desktop\Adam Mallord\Network Version of Databases\Audit_Database\SQL Version\Reports\"

'strReportName = Me.cboReport.Column(1)

strReportName = "rptEmployee_Audit_Scorecard_ByMgr"

While Not rs.EOF
    strWhere = "[Employee] = '" & rs!Employee & "'"
    Debug.Print strWhere
    DoCmd.OpenReport strReportName, acPreview, , strWhere

    strFileName = strPath & Format(Date, "yyyy-mm-dd") & rs!Employee & ".PDF"
    If Dir(strFileName) <> "" Then Kill strFileName
    DoCmd.OutputTo acOutputReport, strRptName, acFormatPDF, strFileName, False
    docmd.close acReport, strRptName

NextEmp:
    rs.MoveNext
Wend

MsgBox ("Done")

ProcExit:
On Error Resume Next
rs.Close
Set rs = Nothing
Exit Sub

ProcError:
if err.number = 2501 then
    Resume NextEmp
Else
    MsgBox Err.Number & vbCrLf & Err.Description, , "Scorecard Click"
    Debug.Print "Scorecard Click", Err.Number, Err.Description
    Resume ProcExit
End If

End Sub

Open in new window

0
 

Author Comment

by:gdunn59
ID: 40545661
Dale,

I tried your last posting with the air trapping but still get the same message that there is no records for this manager. I know there are records for this particular manager because I looked it up in the database.

anyway I'm cleaning up the database so I can upload a copy for you. I should have that done in a couple hours and will post it when it when it's completed.

Thanks,

gdunn59
0
 

Author Comment

by:gdunn59
ID: 40545934
Dale,

Here is my database that contains bogus data.  I've also changed/removed a lot of the objects/data, so it is in no way the entire database, but it is enough for you to hopefully figure it out.

First, create you a folder on your c: drive "Report", so it would be c:\Report.  Next, open the Form "frmReports", and on the first drop-down, choose "Manager", then the second drop-down (I've removed all the other Managers and just left the one bogus one - Jones, Kayrn), choose that one, then the third drop-down (Dept), choose "EGR - Employer Group Retiree", then for the "Begin Date" enter 12/01/2014, and for the "End Date" enter 12/31/2014, then to run the Report (that I'm having issues with) click on the last button on the left at the bottom "Process Employee Scorecard by Manager".  It will start to process the first Report (PDF) for "Dina Anders", and once it creates that, that's when the error occurs saying that there are no records for the Manager.

Thank you for all your assistance with this.  Hope you can figure out the issue.
Audit-Database-SQL-Release-5.0--01-9-201
0
 
LVL 47

Expert Comment

by:Dale Fye (Access MVP)
ID: 40546371
gdunn,

I won't get a chance to look at this today (tue), but will take a look tomorrow.
0
 

Author Comment

by:gdunn59
ID: 40546626
Ok.  Thanks!
0
 

Accepted Solution

by:
gdunn59 earned 0 total points
ID: 40548178
I finally got it to work.   I added the following line of code to a module:

   Public strRptFilter As String

I also added the following line of code to the Open Event of the Report:

   If Len(strRptFilter) <> 0 Then
     Me.Filter = strRptFilter
     Me.FilterOn = True
  End If

and the following line of code to the Close Event of the Report:

   strRptFilter = vbNullString

Here is the code:
Private Sub cmdEmpScorecardRptByMgr_Click()
On Error GoTo ProcError
'Variables
Dim rs As DAO.Recordset
Dim strSQL As String
Dim strWhere As String
Dim strPath As String
Dim strReportName As String

strSQL = "SELECT DISTINCT tblEmployee_Audits.Employee " _
  & "FROM tblEmployee_Audits " _
  & "WHERE ([Manager_Name] = '" & Forms!frmReports![cboCategSelect] & "' " _
  & " And [Audit_Status] = 'Completed') "

If Forms!frmReports!txtBeginDT & "" = "" Then
    'don't add anything to the SQL, if BeginDT is NULL, then select all employees
    'for the selected manager where status is "Completed"
ElseIf Forms!frmReports![txtEndDT] & "" = "" Then
    strSQL = strSQL & " AND [Quality_Review_Date] >= #" _
        & Forms!frmReports![txtBeginDT] & "#"
Else
    strSQL = strSQL & " AND [Quality_Review_Date] Between #" _
        & Forms!frmReports![txtBeginDT] & "# And #" _
        & Forms!frmReports![txtEndDT] & "# "
End If

Debug.Print strSQL

Set rs = CurrentDb.OpenRecordset(strSQL, dbOpenSnapshot)

strPath = "C:\Users\ab56446\Desktop\Adam Mallord\Network Version of Databases\Audit_Database\SQL Version\Reports\"
strReportName = "rptEmployee_Audit_Scorecard_ByMgr"

Do While Not rs.EOF
    strRptFilter = "[Employee] = '" & rs!Employee & "'"
    
    Debug.Print strRptFilter

    DoCmd.OutputTo acOutputReport, strReportName, acFormatPDF, strPath & "\" & rs![Employee] & ".pdf"
    DoEvents
    rs.MoveNext
Loop

rs.Close
Set rs = Nothing

MsgBox ("Report Processing Completed")

ProcExit:
On Error Resume Next
Exit Sub

ProcError:
    MsgBox Err.Number & vbCrLf & Err.Description, , "Scorecard Click"
    Debug.Print "Scorecard Click", Err.Number, Err.Description
    Resume ProcExit

End Sub

Open in new window



The only thing that still isn't working is what it does if the dates are blank.  If the Begin Date and End Dates are blank then it should pull all the records.  If the Begin Date is populated but the End Date is blank, then it should pull records from the begin date and on, and if the Begin Date and End Dates are populated, then it should only pull for those dates.

Thanks,
gdunn59
0
 
LVL 47

Assisted Solution

by:Dale Fye (Access MVP)
Dale Fye (Access MVP) earned 500 total points
ID: 40548653
I've never done it that way, gut I can see how that would work.

The dates part should be covered by that IF statement we put in the code, just prior to opening the employee recordset.  you might want to check the value of strSQL for various date combinations and make sure that IF statement is working the way you expect.
0
 

Author Comment

by:gdunn59
ID: 40626051
test
0
 

Author Closing Comment

by:gdunn59
ID: 40641369
Although my solution was the one that worked, I wanted to give Dale the points since he hung in there with me and tried several solutions.  

Thanks,
gdunn59
0

Featured Post

How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

Join & Write a Comment

Suggested Solutions

Technology opened people to different means of presenting information, but PowerPoint remains to be above competition. Know why PPT still works today.
This code takes an Excel list of URL’s and adds a header titled “URL List”. It then searches through all URL’s in column “A”, looking for duplicates. When a duplicate is found, it is moved to the top of the list. The duplicate URL’s are then highlig…
The viewer will learn how to use a discrete random variable to simulate the return on an investment over a period of years, create a Monte Carlo simulation using the discrete random variable, and create a graph to represent the possible returns over…
Polish reports in Access so they look terrific. Take yourself to another level. Equations, Back Color, Alternate Back Color. Write easy VBA Code. Tighten space to use less pages. Launch report from a menu, considering criteria only when it is filled…

708 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

18 Experts available now in Live!

Get 1:1 Help Now