Hello Pradeep,
This macro will send the emails out when today's date is 2 days before the end date. A button has been added to the sheet to run the macro. The attached workbook has the macro added.
' Thread: http://www.excelforum.com/excel-programming/790637-script-or-macro-to-send-an-email.html
' Poster: pradeepkodali
' Written: September 01, 2011
' Author: Leith Ross
' Summary: Send Email from a Worksheet Range using Outlook
Public olApp As Object
Sub SendEmails()
Dim Cell As Range
Dim olMail As Object
Dim Rng As Range
Dim Wks As Worksheet
Set Wks = ActiveSheet
Set Rng = Wks.Range("A1").CurrentRegion
Set Rng = Rng.Offset(1, 0).Resize(RowSize:=Rng.Rows.Count - 1)
If olApp Is Nothing Then Set olApp = CreateObject("Outlook.Application")
For Each Cell In Rng.Columns(4).Cells 'Column "D"
If DateDiff("d", Now(), Cell) = 2 Then
Set olMail = olApp.CreateItem(olMailItem)
With olMail
.To = Cell.Offset(0, 3) 'Column "G"
.Subject = Cell.Offset(0, -2) 'Column "B
.Body = "Dear Owner " & Cell.Offset(0, 2) & vbCrLf & vbCrLf _
& "Reminder!! You have 2 more days to complete this task." & vbCrLf & vbCrLf _
& "Regards," & vbCrLf & "Pradeep Kodali"
.Send
End With
End If
Next Cell
'Logoff and Quit
olApp.Quit
Set olApp = Nothing
End Sub
Bookmarks