Excel to generate auto emails for missed deadlines

[Eternal Student]

HI

I would like Excel to auto generate an email through Outlook if a project deadline is missed. This would also apply to the second and third deadline. Each email would have a different body sent to the recipient.
The trigger would be the project status cell(s) under columns " O, Q and S ".

Thank you.

Regards,

VN

 

[JustJohn91]

Sub SendEmail()
Application.ScreenUpdating = False
Dim EmailApp As Outlook.Application
Dim Source As String
Set EmailApp = New Outlook.Application

Dim EmailItem As Outlook.MailItem
Dim wdDoc As Object
Dim oRng As Object
Dim olInsp As Object


Dim LastRow As String

FirstDeadlineEmail = "C:\Users\John\Desktop\FirstDeadlineEmail.msg" 'Path to First Email Draft .msg file
SecondDeadlineEmail = "C:\Users\John\Desktop\SecondDeadlineEmail.msg" 'Path to Second Email Draft .msg file
ThirdDeadlineEmail = "C:\Users\John\Desktop\ThirdEmail.msg" 'Path to Third Email Draft .msg file
    
LastRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row

For R = 2 To LastRow
    If Range("S" & R).Value = "Deadline Missed" Then 'Change this to whatever wording you require
        Set EmailItem = EmailApp.CreateItemFromTemplate(ThirdDeadlineEmail)
        EmailItem.To = Cells(R, 1) 'Cell address containing Recipients email address
    
        With EmailItem
            'Comment out Display and uncomment send to issue automatically
            .Display
            '.send
        End With
    ElseIf Range("Q" & R).Value = "Deadline Missed" Then 'Change this to whatever wording you require
        Set EmailItem = EmailApp.CreateItemFromTemplate(SecondDeadlineEmail)
        EmailItem.To = Cells(R, 1) 'Cell address containing Recipients email address
        With EmailItem
            'Comment out Display and uncomment send to issue automatically
            .Display
            '.send
        End With
    ElseIf Range("O" & R).Value ="Deadline Missed" Then 'Change this to whatever wording you require
        Set EmailItem = EmailApp.CreateItemFromTemplate(FirstDeadlineEmail)
        EmailItem.To = Cells(R, 1) 'Cell address containing Recipients email address
        With EmailItem
   
            .Display
            '.send
        End With
    End If
Next R

End Sub

 

[Eternal Student]

Thank you so much for your response / solution. To extend this, will this pull a pre-type message in the body of the email as each escalating email will have different data. Thank you