Hello everybody,
I have a report that runs has an Access function in it to get the month name and year in a text box
Code:
=MonthName(Month([log_date])) & ' ' & Year([log_date])
and a user defined function which gets the weekending date
Code:
=we_date_func([log_date])
When I run the report apart from the code I use in the application (by double clicking on it), it pulls the Month/Year & Weekending Date respectively correctly. When I run my code to filter it, it gives me a #type error in the Month/Year text box and a "#error" in weekending date text box. It's almost like it can't access these functions while the code is running. I say this because my code exports the report in .pdf format to a directory and attaches it to an email. When I open the report in the email, the dates are as they should be. Even though the report in Access is still up w/ the errors on it. Can anyone help me w/ this?
Code:
Public Sub email_all_sups_assocs()
On Error GoTo Err_handler
Dim objOutlook As Outlook.Application
Dim objEmail As Outlook.MailItem
Dim var_attach_1 As String
Dim var_attach_2 As String
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim rs2 As DAO.Recordset
Dim var_prod_rpt As String
Dim var_qual_rpt As String
Dim var_man_crit As String
Dim var_sql As String
Dim var_search_sql As String
Dim var_review_msg As VbMsgBoxResult
Dim var_review_flag As Boolean
Dim var_rpt_frm As Object
Dim var_date_crit As String
Dim var_assoc_crit As String
var_prod_rpt = "assoc_prod_rpt"
var_qual_rpt = "assoc_qual_rpt"
var_man_crit = "manager_id = '" & var_assoc_id & "'"
var_sql = "SELECT full_name, a.assoc_id, a.dsu_id, d.manager_id, a.email " & _
"FROM (qp_assocs AS a INNER JOIN DSUS AS d ON a.dsu_id = d.dsu_id) " & _
"INNER JOIN assoc_full_name_qry AS afn ON afn.assoc_id = a.assoc_id " & _
"WHERE " & var_man_crit
Set db = CurrentDb
Set rs = db.OpenRecordset(var_sql, dbOpenDynaset)
Set rs2 = db.OpenRecordset("assoc_daily_prod_qry", dbOpenDynaset)
Set objOutlook = CreateObject("Outlook.application")
Set var_rpt_frm = Forms!navigation_form.Nav_Subform_1.Form
var_date_crit = "log_date between #" & var_rpt_frm.from_date_txt & "# and # " & var_rpt_frm.to_date_txt & "# "
'verify if user wants a chance to review all reports before sending them
var_review_msg = MsgBox("Would you like to review each report before sending them?", vbQuestion + vbYesNoCancel)
If var_review_msg = vbYes Then
var_review_flag = True
ElseIf var_review_msg = vbNo Then
var_review_flag = False
Else
Exit Sub
End If
If rs.BOF Or rs.EOF Then 'check to see if recordset populated
MsgBox "No Associates Assigned to your user ID.", vbExclamation
Exit Sub
Else
'populate recordset
rs.MoveLast
rs.MoveFirst
End If
Do While Not rs.EOF
'Output Reports
'IMPORTANT: Make sure the location you select to save your reports to exists, Access will & _
'not create the folders for you. -->
rs2.MoveLast
rs2.MoveFirst
rs2.FindFirst var_date_crit & " and full_name ='" & rs!Full_Name & "'"
If Not rs2.NoMatch Then
DoCmd.OpenReport "assoc_prod_rpt", acViewReport, , var_date_crit & " and full_name ='" & rs!Full_Name & "'"
DoCmd.OpenReport "assoc_qual_rpt", acViewReport, , "we_date between #" & var_rpt_frm.from_date_txt & _
"# and # " & var_rpt_frm.to_date_txt & "# and full_name ='" & rs!Full_Name & "'"
DoCmd.OutputTo acOutputReport, var_prod_rpt, acFormatPDF, "C:\Production Report.pdf", False
DoCmd.OutputTo acOutputReport, var_qual_rpt, acFormatPDF, "C:\Quality Report.pdf", False
Set objEmail = objOutlook.CreateItem(olMailItem) 'placed here have only 2 attachments per email
'Set Attachments
Rem <!-- make sure to correlate the attachments to each of the reports you wish to send -->
var_attach_1 = "C:\Production Report.pdf"
var_attach_2 = "C:\Quality Report.pdf"
'Generate email
With objEmail
.To = rs!email
.Subject = "Quality and Production Reports"
.Attachments.Add var_attach_1
.Attachments.Add var_attach_2
If var_review_flag = True Then
.Display
Else
.Send
End If
End With
'Remove attachments from drive
Kill var_attach_1
Kill var_attach_2
Set objEmail = Nothing 'closed to ensure only 2 attachments per email per loop
End If
rs.MoveNext
Loop
Exit_email_all_sups_assocs:
Exit Sub
Err_handler:
MsgBox "Error number " & Err.Number & ": " & Err.Description
Resume Exit_email_all_sups_assocs
End Sub