Dec 22 2020 03:55 AM
Dec 22 2020 06:13 AM
There are several components to this task including:
The way to put that all together depends, in part, on how your tables are designed, and also on how you want to trigger this process. It also depends on what email client your organization uses.
This is going to have to be a generic description since we don't have those details from you yet.
Write a query that selects tasks from the task table.
Select TaskID, TaskName, TaskDueDate, EmployeeFirstName & " " & EmployeeLastName AS AssignedEmployee
FROM tblTask INNER JOIN tblEmployee On TblTask.AssignedEmployeeID = tblEmployee.EmployeeID
WHERE tblTask.TaskDueDate = DateAdd("D",10,Date) AND tblTask.TaskCompleteDate is Null;
Notice the WHERE clause. It assumes that you do not want to send reminders for tasks that have already been completed ahead of the due date and that you will do this every day, including weekends. If your organization doesn't want to include weekends, the process gets more complicated, of course.
You'll want to set up some method of triggering this process, which can be a command button on a form that a supervisor clicks, or an automatic process that runs when the accdb is opened every day or some other event occurs....
You will also need a VBA function to loop through the recordset generated by this query and send an email message to the employees selected.
Here's a template that you can modify to your situation.
Private Sub SendEmailReminder()
Dim varX As Variant
Dim rstEmailList As DAO.Recordset
Dim db As DAO.Database
Dim strSQL As String
Dim strReminder As String
Dim strEmployeeName As String
Dim strReminderText As String
Dim strToAddress as String
Dim lngTaskID As Long
Dim lngprogramID As Long
On Error GoTo errHandler
varX = SysCmd(acSysCmdInitMeter, "Please wait while the email list is prepared and sent...", 0)
Set db = CurrentDb
Set rstEmailList = db.OpenRecordset(Name:="qryTaskDueDate10DayReminder", options:=dbOpenDynaset)
With rstEmailList
Do While Not .EOF
strReminder = vbNullString
lngTaskID = ![TaskID]
strEmployeeName = !AssignedEmployee
strReminderText = "Your Assigned Task, " & !TaskName & ", is due in 10 days."
strToAddress = ![EmailAddress]
Call modEmail.EmailReminder( _
strReminder:=strReminder, _
Recipient:=strEmployeeName, _
ToAddress:=strToAddress, _
strSubject:="Your Assigned Task is Due in 10 Days.", _
strMessage:=strEmployeeName & "<br>" & "<br>" & _
strReminderText & "<br>" & "<br>", _
strEmailFROM:="YourSenderEmailAddress@YourOrg.com", _
Attachment:=vbNullString)
.MoveNext
Loop
End With
exitProc:
varX = SysCmd(acSysCmdRemoveMeter)
Me.Repaint
Exit Sub
errHandler:
MsgBox prompt:=Err & ": " & Err.description, buttons:=vbCritical + vbOKOnly, title:="Unexpected Error"
Resume exitProc
Resume
End Sub
Public Function EmailReceiptByGeneric( _
ByVal strReceipt As String, _
ByVal Recipient As String, _
ByVal ToAddress As String, _
ByVal strProgram As String, _
ByVal Attachment As String, _
ByVal strSubject As String, _
ByVal strMessage As String, _
ByVal strEmailFROM As String, _
Optional ByVal CC As String) As Boolean
Dim cdoConfig As Object
Dim msgOne As Object
'This example uses gmail. Modify to work with your email server.
On Error GoTo errHandler
EmailReceiptByGeneric = False
Set cdoConfig = CreateObject("CDO.Configuration")
With cdoConfig.Fields
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465 '587 'select the approproprate SMTP Port for your email
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = strEmailFROM
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "SupplyYourPasswordHere"
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
.Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60
.Update
End With
Set msgOne = CreateObject("CDO.Message")
Set msgOne.Configuration = cdoConfig
msgOne.To = ToAddress
msgOne.FROM = strEmailFROM
msgOne.Subject = strSubject
msgOne.htmlBody = strMessage & "<br/>" & "<br/>" & "<br/>" & "<br/>" & _
strReceipt
msgOne.send
EmailReceiptByGeneric = True
Cleanup:
On Error GoTo 0
On Error Resume Next
exitProc:
Exit Function
errHandler:
EmailReceiptByGeneric = False
MsgBox prompt:="There was an error in the attempt to send email through " & strEmailFROM & "." & vbCrLf & vbCrLf, _
buttons:=vbCritical + vbOKOnly, title:="Unable to Send Email through " & strEmailFROM
Resume Cleanup
Resume
End Function