Two different messages for each notification

marvel

New member
Joined
Oct 24, 2013
Messages
2
Reaction score
0
Points
0
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


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!!
 

NoS

New member
Joined
Jan 17, 2013
Messages
832
Reaction score
0
Points
0
Location
British Columbia
Excel Version(s)
Excel 2010
In the function, shouldn't strBody1 or strBody2 be determined by the date in column 4 being in the future rather than the past?
 

marvel

New member
Joined
Oct 24, 2013
Messages
2
Reaction score
0
Points
0
In the function, shouldn't strBody1 or strBody2 be determined by the date in column 4 being in the future rather than the past?

Exactly...I realized this and used case

For i = 3 To RowNumber

Select Case Date
Case WorkSheetSource.Cells(i, 4) - 30
strBody = strBody1
Case WorkSheetSource.Cells(i, 4) - 15
strBody = strBody2
End Select
Next i


everything works now! Thanks for the reply
 
Top