Option Explicit
Sub eMail()
Dim lRow As Integer
Dim i As Integer
Dim toDate As Date
Dim toList As String
Dim eSubject As String
Dim eBody As String
Dim OutApp
Dim OutMail
With Application
.ScreenUpdating = False
.EnableEvents = False
.DisplayAlerts = False
End With
Sheets(1).Select
lRow = Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To lRow
toDate = Sheets("Sheet1").Cells(i, 1)
If toDate < Date Then: Exit Sub
If Left(Cells(i, 5), 4) <> "Mail" And toDate = Date Then
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
toList = Cells(i, 2) 'gets the recipient from col B
eSubject = Cells(i, 3) 'gets subject from col C
eBody = Cells(i, 4) 'gets body of email from col D
'enter email body here
On Error Resume Next
With OutMail
.To = toList
.CC = ""
.BCC = ""
.Subject = eSubject
.Body = eBody
.bodyformat = 1
.Display ' ********* Creates draft emails. Comment this out when you are ready
'.Send '********** UN-comment this when you are ready to go live
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
Cells(i, 5) = "Mail Sent " & Date + Time 'Marks the row as "email sent in Column C"
End If
Next i
ActiveWorkbook.Save
With Application
.ScreenUpdating = True
.EnableEvents = True
.DisplayAlerts = True
End With
MsgBox "All emails have been sent. ", vbInformation, "Email Notice "
End Sub
Sub sbInsertingRows()
'Inserting a Row at at Row 2
Range("A2").EntireRow.Insert
End Sub
