Tech Support Guy banner
Status
Not open for further replies.

Automatic Outlook mail due date reminder based on Excel file

49K views 6 replies 2 participants last post by  iamitp 
#1 ·
Hi Everyone!

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.

I'd really appreciate any help,

Thanks
 

Attachments

#2 ·
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
 

Attachments

#4 ·
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
 
#5 ·
Thank you so much!

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.....
 
Status
Not open for further replies.
You have insufficient privileges to reply here.
Top