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