I am creating a routine that will send notifications in outlook based on a future date. I have two notifications (reminders) 30 days and 15 days prior to due date.
I want to have 2 different email messages for each reminder notification. I am alittle stuck on how to have this choose messages between the two dates. How can I achieve this on what I have so far
Email sends but only for the 1st message( 30days) even if the cell has 15 days. Any help would be much appreciated!!
I want to have 2 different email messages for each reminder notification. I am alittle stuck on how to have this choose messages between the two dates. How can I achieve this on what I have so far
Code:
Public Sub SendReminderNotices()
' ****************************************************************
' Define Variables
' ****************************************************************
Dim wkbReminderList As Workbook
Dim wksReminderList As Worksheet
Dim lngNumberOfRowsInReminders As Long
Dim i As Long
' ****************************************************************
' Set Workbook and Worksheet Variables
' ****************************************************************
Set wkbReminderList = ActiveWorkbook
Set wksReminderList = ActiveWorkbook.ActiveSheet
' ****************************************************************
' Determine How Many Rows Are In the Worksheet
' ****************************************************************
lngNumberOfRowsInReminders = wksReminderList.Cells(Rows.Count, "A").End(xlUp).Row
' ****************************************************************
' For Any Items That Don't Have A Date In Columns 15 or 16,
' Check To See If The Reminder Is Due.
'
' If Reminder Is Due, then Send An Email.
' If Successful, Log The Date Sent in Column 15 or 16
' ****************************************************************
For i = 2 To lngNumberOfRowsInReminders
' ****************************************************************
' First Reminder Date Check
' ****************************************************************
If wksReminderList.Cells(i, 15) = "" Then
If wksReminderList.Cells(i, 4) - 30 = Date Then
If SendAnOutlookEmail(wksReminderList, i) Then
wksReminderList.Cells(i, 15) = Date 'Indicate That Reminder1 Was Successful
End If
End If
Else
' ****************************************************************
' Second Reminder Date Check
' ****************************************************************
If wksReminderList.Cells(i, 16) = "" Then
If wksReminderList.Cells(i, 4) - 15 = Date Then
If SendAnOutlookEmail(wksReminderList, i) Then
wksReminderList.Cells(i, 16) = Date 'Indicate That Reminder2 Was Successful
End If
End If
End If
End If
Next i
End Sub
________________________________________________________________________________________
Private Function SendAnOutlookEmail(WorkSheetSource As Worksheet, RowNumber As Long) As Boolean
Dim strMailToEmailAddress As String
Dim strCctoEmail As String
Dim strSubject As String
Dim strBody1 As String
Dim strBody2 As String
Dim strBody As String
Dim OutApp As Object
Dim OutMail As Object
Dim i As Long
SendAnOutlookEmail = False
strMailToEmailAddress = WorkSheetSource.Cells(RowNumber, 13)
strCctoEmail = "Name"
strSubject = "Reminder Notification"
strBody1 = "Message1"
strBody2 = "Message2"
For i = 2 To RowNumber
If WorkSheetSource.Cells(i, 4) = Date - 30 Then
strBody = strBody1
Else
If WorkSheetSource.Cells(i, 4) = Date - 15 Then
strBody = strBody2
Else
SendAnOutlookEmail = False
Exit Function
End If
End If
Next i
' ****************************************************************
' Create The Outlook Mail Object
' ****************************************************************
Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon "Outlook"
Set OutMail = OutApp.CreateItem(0)
' ****************************************************************
' Send The Email
' ****************************************************************
On Error GoTo ErrorOccurred
With OutMail
.To = strMailToEmailAddress
'.Cc = strCctoEmail
.Subject = strSubject
.Body = strBody
.Send
End With
' ****************************************************************
' Mail Was Successful
' ****************************************************************
SendAnOutlookEmail = True
Continue:
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
Exit Function
' ****************************************************************
' Mail Was Not Successful
' ****************************************************************
ErrorOccurred:
Resume Continue
End Function
Email sends but only for the 1st message( 30days) even if the cell has 15 days. Any help would be much appreciated!!