This is my first post here. I need your help in developing a mechanism to send an automated outlook mail, when the due date of a project is 7 days away from the current date. The script should preferably run automatically every time the PC is running. without the excel file necessarily open.
In the attached excel file, An email should go of to -email address (Col. D), with subject "Project (Col. B) is due on Due date(Col. C)", and body "Dear Name(Col. A), please update your project status".
Also, the script should put a check mark on Reminder sent column (Col. E) after the mail is sent, the script should also check if the value of the cell is blank before sending email.
I have scoured the forum for similar problems, and although I found a number of of threads,I am not proficient enough in VBA to modify them to my needs.
Here is some code that will generate the emails you want to send. Unfortunately the file must be open to run the macro. You can use the scheduler to open the file and run the macro automatically.
Code:
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
With Application
.ScreenUpdating = False
.EnableEvents = False
.DisplayAlerts = False
End With
Sheets(1).Select
lRow = Cells(Rows.Count, 4).End(xlUp).Row
For i = 2 To lRow
toDate = Replace(Cells(i, 3), ".", "/")
If Left(Cells(i, 5), 4) <> "Mail" And toDate - Date <= 7 Then
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
toList = Cells(i, 4) 'gets the recipient from col D
eSubject = "Project " & Cells(i, 2) & " is due on " & Cells(i, 3)
eBody = "Dear " & Cells(i, 1) & vbCrLf & vbCrLf & "Please update your project status."
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 A"
End If
Next i
ActiveWorkbook.Save
With Application
.ScreenUpdating = True
.EnableEvents = True
.DisplayAlerts = True
End With
End Sub
near the end there is a .display and .send. uncomment the .send (delete the single quote) and add the quote to the .display, like so;
Code:
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
With Application
.ScreenUpdating = False
.EnableEvents = False
.DisplayAlerts = False
End With
Sheets(1).Select
lRow = Cells(Rows.Count, 4).End(xlUp).Row
For i = 2 To lRow
toDate = Replace(Cells(i, 3), ".", "/")
If Left(Cells(i, 5), 4) <> "Mail" And toDate - Date <= 7 Then
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
toList = Cells(i, 4) 'gets the recipient from col D
eSubject = "Project " & Cells(i, 2) & " is due on " & Cells(i, 3)
eBody = "Dear " & Cells(i, 1) & vbCrLf & vbCrLf & "Please update your project status."
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 A"
End If
Next i
ActiveWorkbook.Save
With Application
.ScreenUpdating = True
.EnableEvents = True
.DisplayAlerts = True
End With
End Sub
After I uncommented the relevant code, mail goes out perfectly! Only problem is when I change all three due dates to 14/07/2014 (within a week), one the first entry (row 2) is mailed (amit@amit.com) and only E2 has the text "Mail Sent 08/07/2014 15:01:32".The other rows are not being mailed.....
Yes it is working great! Thanks a ton Xcubed! You are a genius
Status
Not open for further replies.
You have insufficient privileges to reply here.
Related Threads
?
?
?
?
?
Tech Support Guy
9.9M posts
859.7K members
Since 1998
A forum community dedicated to tech experts and enthusiasts. Come join the discussion about articles, computer security, Mac, Microsoft, Linux, hardware, networking, gaming, reviews, accessories, and more!