# Automatic Outlook mail due date reminder based on Excel file



## iamitp (Sep 29, 2006)

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


----------



## XCubed (Feb 22, 2013)

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.


```
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
```


----------



## iamitp (Sep 29, 2006)

Thanks Xcubed! It works like a charm! 

Can you please help me modify the code so that the mail is sent (instead of opening the mail window).

Amit


----------



## XCubed (Feb 22, 2013)

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;


```
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
```


----------



## iamitp (Sep 29, 2006)

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 ([email protected]) and only E2 has the text "Mail Sent 08/07/2014 15:01:32".The other rows are not being mailed.....


----------



## XCubed (Feb 22, 2013)

it works for me. try with my test file.


----------



## iamitp (Sep 29, 2006)

Yes it is working great! Thanks a ton Xcubed! You are a genius


----------

