Jim,
Check the spellings of all field names. I expect on is wrong. Use some of the debugging tips that have been suggested here like:
strSql = "SELECT Distinct SupervisorTable.[Dept Head], SupervisorTable.[Asc/Ast Dir], SupervisorTable.Supervisor, SupervisorTable.[Ast Sup/Lead], Nz([Ast sup/lead],Nz([Supervisor],Nz([Ast Director],Nz([Dept Head],'Top Dog')))) AS ImmedSup" _
& " FROM SupervisorTable " _
& " WHERE (((SupervisorTable.[Person Id]) Not Like '1208509350'));"
Debug.Print strSQL
You can then copy the strSQL from the debug window and paste into an empty query SQL view. You will probably find out very quickly which field is wrong.
Duane
Sent: Monday, October 2, 2017 4:58 PM
To: MS_Access_Professionals@yahoogroups.com
Subject: [MS_AccessPros] Emailing reports question
Hello all,
I am trying to email reports as attachments to the 94 Immediate Supervisors of accruals for the employees they are managing. I have copied the code from another button that does the same thing. So I just changed the names to be relevant to the new process. But I have been working on this all day and tried all kinds of ways to do this. I am currently getting a error message that says Run time error 3061 Too few parameters. Expected 1. when I debug it It highlights this line.
Set RS_1 = db.OpenRecordset(strSql, dbOpenDynaset)
I had it working this morning but there was no data in the report but it was sending the reports, so it was completing the procedure but with no data on the reports. So I decided to change the strSql and it is crashing.
Can anyone point out my errors?
Thank You
Jim Wagner
Here is the complete procedure
Private Sub cmdEmailReportToSupervisor_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
DoCmd.SetWarnings False
strSql = "SELECT Distinct SupervisorTable.[Dept Head], SupervisorTable.[Asc/Ast Dir], SupervisorTable.Supervisor, SupervisorTable.[Ast Sup/Lead], Nz([Ast sup/lead],Nz([Supervisor],Nz([Ast Director],Nz([Dept Head],'Top Dog')))) AS ImmedSup" _
& " FROM SupervisorTable " _
& " 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\Labor Analysis Database\Department Reports\"
'myPath = "W:\Labor Analysis Lists"
myPath = "U:\"
' 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.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]='" & ReportsToName & "'"
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 " & ReportsToName
.HTMLBody = "Testing" 'strMsg
.NoAging = True
.Attachments.Add myFileName
.Display
End With
SendKeys "%{s}", True
End If
RS_1.MoveNext
Loop
MsgBox "Report has been emailed."
End Sub
Posted by: Duane Hookom <duanehookom@hotmail.com>
| Reply via web post | • | Reply to sender | • | Reply to group | • | Start a New Topic | • | Messages in this topic (2) |
Tidak ada komentar:
Posting Komentar