Automatic email remainder based on due date in ms access

Ramanareddy212798 

There are several components to this task including:

• A way to select the tasks due in exactly 10 days
• A way to select the email addresses for the employees assigned to those tasks
• A way to compose and send the email notices.

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