Two different messages for each notification

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