Hi Jim,
First you need to change the Dim of RW_1 which your code is not necessarily creating a DAO.Recordset
Dim RS_1 As DAO.Recordset, RS_2 As DAO.Recordset
I assume the record source of your report is qryReportASWRT.
Change the "strSQL" to "strSQL2" in the third line below and add a debug.print
If Not IsNull(ImmedSup) Then
strSQL2 = "SELECT * FROM qryReportsTo WHERE ImmedSup=""" & ImmedSup & """"
'Change the report recordsource query to filter by ImmedSup
strPrevSQL = fChangeSQL(strQueryName, strSQL2)
debug.print strSQL2 ' allows you to view the SQL statement
DoCmd.OpenReport "rptAccrualSummaryWithReportsTo", acViewReport
'DoCmd.OpenReport "rptAccrualSummaryWithReportsTo", acViewReport, , "ImmedSup=" & """" & ImmedSup & """", acNormal
DoCmd.OutputTo acOutputReport, "rptAccrualSummaryWithReportsTo", "PDFFormat(*.pdf)", myFileName, False, "", 0, acExportQualityPrint
DoCmd.Close acReport, "rptAccrualSummaryWithReportsTo"
End If
Sent: Wednesday, November 8, 2017 1:43 PM
To: Duane Hookom duanehookom@hotmail.com [MS_Access_Professionals]
Subject: Re: [MS_AccessPros] Filter report with vba
Private Sub cmdEmailAccrualSummaryDirectReport_Click()
Dim db As DAO.Database
Set db = CurrentDb
Dim RS_1, RS_2 As DAO.Recordset
Dim strMsg As String
Dim ReportsToName, EmailAddress, SupervisorEmail, ImmedSup As String
Dim myPath, myFileName As String
Dim strSQL, strSQL1, strSQL2 As String
Dim objol As New Outlook.Application
Dim objmail As MailItem
Set objol = New Outlook.Application
Dim strQueryName As String
Dim strPrevSQL As String
Dim strSQL3 As String
strQueryName = "qryReportASWRT"
DoCmd.SetWarnings False
strSQL = "SELECT DISTINCT Nz([Asc/Ast Dir],Nz([Dept Head],'Top Dog')) AS ImmedSup" _
& " FROM SupervisorTable INNER JOIN AccrualsForReport ON SupervisorTable.[Person Id] = AccrualsForReport.Emplid" _
& " WHERE (((SupervisorTable.[Person Id]) Not Like '1208509350'));"
' Open the record set containing all the supervisors
Set RS_1 = db.OpenRecordset(strSQL, dbOpenDynaset)
RS_1.MoveFirst
' Set the path to the folder which stores all the reports
myPath = "W:\ADMINISTRATIVE SERVICES DATABASES\MANAGEMENT SUPPORT SERVICES T-A-P\ABSENCE DATABASE\Department Reports\DirectReports\"
' For all entries, loop through, generate, store and email the report
Do While Not RS_1.EOF
' This routine is divided into two parts - 1) generate and store the report and 2) email the report
' We generate the report for all supervisors and store them in the designated folder.
'**********************************************************************************************************************
' Section 1 - generate and store reports
'**********************************************************************************************************************
' Obtain the supervisor's name
ImmedSup = RS_1!ImmedSup 'the Supervisor is being renamed here. It originally is SupervisorName from the value that is in the Supervisor field from the strSQL above in the code, which is a list of all the supervisor name
myFileName = myPath & "Accruals Report - " & ImmedSup & ".pdf" 'the SupervisorName is the value of the Supervisor field from the strSQL above in the code, which is a list of all the supervisors names
' Open the report with the filter and export it as PDF to the designated folder. Close the report.
If Not IsNull(ImmedSup) Then
strSQL2 = "SELECT * FROM qryReportsTo WHERE ImmedSup=""" & ImmedSup & """"
'Change the report recordsource query to filter by ImmedSup
strPrevSQL = fChangeSQL(strQueryName, strSQL)
DoCmd.OpenReport "rptAccrualSummaryWithReportsTo", acViewReport
'DoCmd.OpenReport "rptAccrualSummaryWithReportsTo", acViewReport, , "ImmedSup=" & """" & ImmedSup & """", acNormal
DoCmd.OutputTo acOutputReport, "rptAccrualSummaryWithReportsTo", "PDFFormat(*.pdf)", myFileName, False, "", 0, acExportQualityPrint
DoCmd.Close acReport, "rptAccrualSummaryWithReportsTo"
End If
'**********************************************************************************************************************
' Section 2 - Email reports
'**********************************************************************************************************************
' Obtain the email address for the supervisor, set the subject and body accordingly
' Attach the report and send the mail.
If Not IsNull(ImmedSup) Then
strSQL1 = "SELECT [R&D-CURRENTEMPLOYEES].[Asu Email Addr] FROM [R&D-CURRENTEMPLOYEES] WHERE [R&D-CURRENTEMPLOYEES].[Person Nm]='" & ImmedSup & "'"
Set RS_2 = db.OpenRecordset(strSQL1, dbOpenDynaset)
RS_2.MoveFirst
SupervisorEmail = RS_2![Asu Email Addr]
Set objmail = objol.CreateItem(olMailItem)
With objmail
.BodyFormat = olFormatHTML
.To = SupervisorEmail
.Subject = "Accruals Report for " & ImmedSup
.HTMLBody = "Hello. Attached is your Direct Reports Accrual Summary Report. If you have any questions, please contact the Time and Attendance Team." _
& vbCrLf & vbCrLf & _
" - Thank You - " 'strMsg
.NoAging = True
.Attachments.Add myFileName
.Display
End With
SendKeys "%{s}", True
End If
RS_1.MoveNext
Loop
DoCmd.SetWarnings True
MsgBox "Reports have been emailed to the Direct Reports Employees."
End Sub
Option Compare Database
Function fChangeSQL(pstrQueryName As String, strSQL As String) As String
'=============================================================
' basQueryDefs.ChangeSQL
'-------------------------------------------------------------
' Purpose : update the SQL property of a saved query
' Copyright: Duane Hookom
' Author : Duane Hookom
' Notes :
'-------------------------------------------------------------
' Parameters
'-----------
' pstrQueryName (String) Name of saved query
' strSQL (String) SQL Statement
'-------------------------------------------------------------
' Returns: the previous SQL statement
'-------------------------------------------------------------
' Revision History
'-------------------------------------------------------------
' 07-09-2001 DKH:
'=============================================================
' End Code Header block
Dim db As DAO.Database
Dim qd As DAO.QueryDef
Set db = CurrentDb
Set qd = db.QueryDefs(pstrQueryName)
fChangeSQL = qd.SQL
qd.SQL = strSQL
Set qd = Nothing
Set db = Nothing
End Function
Hi Jim,
Can you share your current code for the function as well as your cmdEmailAccrualSummaryDirectReport_Click?
Duane
Sent: Wednesday, November 8, 2017 12:25 PM
To: Duane Hookom duanehookom@hotmail.com [MS_Access_Professionals]
Subject: Re: [MS_AccessPros] Filter report with vba
Hi Jim,
That function is old. I was thinking it was the one at http://www.tek-tips.com/faqs.cfm?fid=7433.
If you aren't using the function anywhere else in your application, you can replace the function with the one in the link.
| www.tek-tips.com There are times when the easiest method of creating complex queries with multiple filters is to change the SQL property of a saved query. This works well when you ... |
Sent: Monday, November 6, 2017 11:29 AM
To: Duane Hookom duanehookom@hotmail.com [MS_Access_Professionals]
Subject: Re: [MS_AccessPros] Filter report with vba
Function fChangeSQL(pstrQueryName As String, strQueryName As String, strSQL As String) As String
'=============================================================
' basQueryDefs.ChangeSQL
'-------------------------------------------------------------
' Purpose : update the SQL property of a saved query
' Copyright: Duane Hookom
' Author : Duane Hookom
' Notes :
'-------------------------------------------------------------
' Parameters
'-----------
' pstrQueryName (String) Name of saved query
' strSQL (String) SQL Statement
'-------------------------------------------------------------
' Returns: the previous SQL statement
'-------------------------------------------------------------
' Revision History
'-------------------------------------------------------------
' 07-09-2001 DKH:
'=============================================================
' End Code Header block
Dim db As DAO.Database
Dim qd As DAO.QueryDef
Set db = CurrentDb
Set qd = db.QueryDefs(pstrQueryName)
fChangeSQL = qd.SQL
qd.SQL = strSQL
Set qd = Nothing
Set db = Nothing
End Function
Jim,
You are setting the SQL property of a query to select from itself. This is like having [query1] with a SQL statement of "SELECT * FROM [Query1]". It's not possible in Access or possibly other query languages.
1) Create a new query named "qryReportASWRT" that has a sql statement of
"SELECT * FROM qryReportsTo;"
2) Set the Recordsource of rptAccrualSummaryWithReportsTo to qryReportASWRT.
3) Change
strQueryName = "qryReportsTo"
to
strQueryName = "qryReportASWRT"
4) Try again
Regards,
Duane
Sent: Friday, November 3, 2017 5:50 PM
To: Duane Hookom duanehookom@hotmail.com [MS_Access_Professionals]
Subject: Re: [MS_AccessPros] Filter report with vba
Private Sub cmdEmailAccrualSummaryDirectReport_Click()
Dim db As DAO.Database
Set db = CurrentDb
Dim RS_1, RS_2 As DAO.Recordset
Dim strMsg As String
Dim ReportsToName, EmailAddress, SupervisorEmail, ImmedSup As String
Dim myPath, myFileName As String
Dim strSQL, strSQL1 As String
Dim objol As New Outlook.Application
Dim objmail As MailItem
Set objol = New Outlook.Application
Dim strQueryName As String
Dim strPrevSQL As String
Dim strSQL3 As String
strQueryName = "qryReportsTo"
DoCmd.SetWarnings False
strSQL = "SELECT DISTINCT Nz([Asc/Ast Dir],Nz([Dept Head],'Top Dog')) AS ImmedSup" _
& " FROM SupervisorTable INNER JOIN AccrualsForReport ON SupervisorTable.[Person Id] = AccrualsForReport.Emplid" _
& " WHERE (((SupervisorTable.[Person Id]) Not Like '1208509350'));"
' Open the record set containing all the supervisors
Set RS_1 = db.OpenRecordset(strSQL, dbOpenDynaset)
RS_1.MoveFirst
' Set the path to the folder which stores all the reports
myPath = "W:\ADMINISTRATIVE SERVICES DATABASES\MANAGEMENT SUPPORT SERVICES T-A-P\ABSENCE DATABASE\Department Reports\DirectReports\"
' For all entries, loop through, generate, store and email the report
Do While Not RS_1.EOF
' This routine is divided into two parts - 1) generate and store the report and 2) email the report
' We generate the report for all supervisors and store them in the designated folder.
'**********************************************************************************************************************
' Section 1 - generate and store reports
'**********************************************************************************************************************
' Obtain the supervisor's name
ImmedSup = RS_1!ImmedSup 'the Supervisor is being renamed here. It originally is SupervisorName from the value that is in the Supervisor field from the strSQL above in the code, which is a list of all the supervisor name
myFileName = myPath & "Accruals Report - " & ImmedSup & ".pdf" 'the SupervisorName is the value of the Supervisor field from the strSQL above in the code, which is a list of all the supervisors names
' Open the report with the filter and export it as PDF to the designated folder. Close the report.
If Not IsNull(ImmedSup) Then
strSQL = "SELECT * FROM qryReportsTo WHERE ImmedSup=""" & ImmedSup & """"
'Change the report recordsource query to filter by ImmedSup
strPrevSQL = fChangeSQL(strQueryName, strSQL)
DoCmd.OpenReport "rptAccrualSummaryWithReportsTo", acViewReport
'DoCmd.OpenReport "rptAccrualSummaryWithReportsTo", acViewReport, , "ImmedSup=" & """" & ImmedSup & """", acNormal
DoCmd.OutputTo acOutputReport, "rptAccrualSummaryWithReportsTo", "PDFFormat(*.pdf)", myFileName, False, "", 0, acExportQualityPrint
DoCmd.Close acReport, "rptAccrualSummaryWithReportsTo"
End If
'**********************************************************************************************************************
' Section 2 - Email reports
'**********************************************************************************************************************
' Obtain the email address for the supervisor, set the subject and body accordingly
' Attach the report and send the mail.
If Not IsNull(ImmedSup) Then
strSQL1 = "SELECT [R&D-CURRENTEMPLOYEES].[Asu Email Addr] FROM [R&D-CURRENTEMPLOYEES] WHERE [R&D-CURRENTEMPLOYEES].[Person Nm]='" & ImmedSup & "'"
Set RS_2 = db.OpenRecordset(strSQL1, dbOpenDynaset)
RS_2.MoveFirst
SupervisorEmail = RS_2![Asu Email Addr]
Set objmail = objol.CreateItem(olMailItem)
With objmail
.BodyFormat = olFormatHTML
.To = SupervisorEmail
.Subject = "Accruals Report for " & ImmedSup
.HTMLBody = "Hello. Attached is your Direct Reports Accrual Summary Report. If you have any questions, please contact the Time and Attendance Team." _
& vbCrLf & vbCrLf & _
" - Thank You - " 'strMsg
.NoAging = True
.Attachments.Add myFileName
.Display
End With
SendKeys "%{s}", True
End If
RS_1.MoveNext
Loop
DoCmd.SetWarnings True
MsgBox "Reports have been emailed to the Direct Reports Employees."
End Sub
In the sub
Duane
Sent: Friday, November 3, 2017 2:29 PM
To: Duane Hookom duanehookom@hotmail.com [MS_Access_Professionals]
Subject: Re: [MS_AccessPros] Filter report with vba
Sorry, there should have been another line to use strQueryName. Place this line anywhere after the Dims.
strQueryName = "qryReportsTo"
Sent: Friday, November 3, 2017 12:48 PM
To: Duane Hookom duanehookom@hotmail.com [MS_Access_Professionals]
Subject: Re: [MS_AccessPros] Filter report with vba
Jim,
Try:
MN
Sent: Thursday, November 2, 2017 5:18 PM
To: Duane Hookom duanehookom@hotmail.com [MS_Access_Professionals]
Subject: Re: [MS_AccessPros] Filter report with vba
' For all entries, loop through, generate, store and email the report
Do While Not RS_1.EOF
' This routine is divided into two parts - 1) generate and store the report and 2) email the report
' We generate the report for all supervisors and store them in the designated folder.
'**********************************************************************************************************************
' Section 1 - generate and store reports
'**********************************************************************************************************************
' Obtain the supervisor's name
ImmedSup = RS_1!ImmedSup 'the Supervisor is being renamed here. It originally is SupervisorName from the value that is in the Supervisor field from the strSQL above in the code, which is a list of all the supervisor name
myFileName = myPath & "Accruals Report - " & ImmedSup & ".pdf" 'the SupervisorName is the value of the Supervisor field from the strSQL above in the code, which is a list of all the supervisors names
' Open the report with the filter and export it as PDF to the designated folder. Close the report.
If Not IsNull(ImmedSup) Then
'DoCmd.OpenReport "rptAccrualSummaryWithReportsTo", acViewReport
DoCmd.OpenReport "rptAccrualSummaryWithReportsTo", acViewReport, "", "ImmedSup=" & """" & ImmedSup & """", acNormal
'DoCmd.OpenReport "rptAccrualSummaryWithReportsTo", acViewReport, , "ImmedSup=" & """" & ImmedSup & """", acNormal
DoCmd.OutputTo acOutputReport, "rptAccrualSummaryWithReportsTo", "PDFFormat(*.pdf)", myFileName, False, "", 0, acExportQualityPrint
DoCmd.Close acReport, "rptAccrualSummaryWithReportsTo"
End If
Jim,
I actually prefer to change the SQL of the query that is the report's record source. I use a little DAO code as described on this Tek-Tips FAQ http://www.tek-tips.com/faqs.cfm?fid=7433
Duane
| www.tek-tips.com There are times when the easiest method of creating complex queries with multiple filters is to change the SQL property of a saved query. This works well when you ... |
Sent: Thursday, November 2, 2017 1:26 PM
To: Duane Hookom duanehookom@hotmail.com [MS_Access_Professionals]
Subject: Re: [MS_AccessPros] Filter report with vba
Jim,
What happens if you get rid of the first
DoCmd.OpenReport "rptAccrualSummaryWithReportsTo", acViewReport
Regards,
Duane Hookom
MN
Sent: Thursday, November 2, 2017 1:14 PM
To: MS_Access_Professionals@yahoogroups.com
Subject: [MS_AccessPros] Filter report with vba
Hello all,
I am trying to filter a report in VBA. The user wants to limit the records being emailed out for an Accruals report. The user wants to select the employees in a table. Then the report is to be emailed to the supervisors. So I have the following code to open the report. The user will open the table and click a Yes/No check box and then I need the report to use the SelectEmployee field to be used to exclude employees with the check box selected. I have tried to add the filter on the docmd.openreport line but it never filters the report.
Thank You for any help.
Jim Wagner
ImmedSup = RS_1!ImmedSup 'the Supervisor is being renamed here. It originally is SupervisorName from the value that is in the Supervisor field from the strSQL above in the code, which is a list of all the supervisor name
myFileName = myPath & "Accruals Report - " & ImmedSup & ".pdf" 'the SupervisorName is the value of the Supervisor field from the strSQL above in the code, which is a list of all the supervisors names
' Open the report with the filter and export it as PDF to the designated folder. Close the report.
If Not IsNull(ImmedSup) Then
DoCmd.OpenReport "rptAccrualSummaryWithReportsTo", acViewReport
DoCmd.OpenReport "rptAccrualSummaryWithReportsTo", acViewReport, "", "ImmedSup=" & """" & ImmedSup & """", acNormal
DoCmd.OutputTo acOutputReport, "rptAccrualSummaryWithReportsTo", "PDFFormat(*.pdf)", myFileName, False, "", 0, acExportQualityPrint
DoCmd.Close acReport, "rptAccrualSummaryWithReportsTo"
End If
Posted by: Jim Wagner <luvmymelody@yahoo.com>
| Reply via web post | • | Reply to sender | • | Reply to group | • | Start a New Topic | • | Messages in this topic (20) |
Tidak ada komentar:
Posting Komentar