Automatically send email from excel file due date to outlook

[jevi]

Hi all,

I have an excel file that I have an expiration date and I would like that when the date is -15 days before expire to send an email automatically based on some cells information to the outlook email. I have read a lot of articles and it sounds as if the file of excel is closed cannot work to send this message automatically from excel file to outlook....so the file should be opened, I am right? Still, I would prefer that it could work with the file closed but still, I can handle it also as the file I can save it in XLSTART so it would automatically open every time I open the computer.

My example:

So the message with be sent always to the same 3 email addresses but I would like the message to be based on Cell B, C, D, E

Message:
The contract " cell B2" with "cell C2" date of contract " cell D2" that expires " cell E2".

Thank you,
Signature

A	B	C	D	E	F	G
1	Contract Type	Description	Date of Contract	Due to	Alert	Email to
2	Maintenance Webex​	Technical administration​	10/01/2020​	30/09/2021​	TRUE	j@outlook.com; x@outlook.com;h@outlook.com​
3	Utility​	Electricity, water​	01/02/2019​	05/11/2021​	FALSE	j@outlook.com; x@outlook.com;h@outlook.com​

I did a lot of research online but I did find something that suits my case. Thank you for the help.

 

[Logit]

Try this :

Sub emailall()
Dim lRow As Integer
Dim i As Integer
Dim toDate As Date
Dim toList, CCList As String
Dim eSubject As String
Dim eBody As String
Dim OutApp, OutMail


With Application
    .ScreenUpdating = False
    .EnableEvents = False
    .DisplayAlerts = False
End With


Sheets("Sheet1").Select
lRow = Cells(Rows.Count, 2).End(xlUp).Row

Set OutApp = CreateObject("Outlook.Application")

For i = 2 To lRow
  If Cells(i, 3).Value = Date + 15 Then
     Set OutMail = OutApp.CreateItem(0)


        toList = Cells(i, 2)    'gets the recipient from col B
        CCList = Cells(i, 8) & ", " & Cells(i, 9) & ", " & Cells(i, 10)
        eSubject = "You are scheduled for an audit on " & Cells(i, 3) & " at " & Cells(i, 4) & " " & Cells(i, 6)
        eBody = "Greetings : " & vbCrLf & vbCrLf & "Scheduled audit is upcoming on the date indicated above."
        
        On Error Resume Next
        With OutMail
        .To = toList
        .CC = CCList
        .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
 Cells(i, 12) = "Mail Sent " & Date + Time 'Marks the row as "email sent in Column A"
End If
Next i

Set OutApp = Nothing

ActiveWorkbook.Save


With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .DisplayAlerts = True
End With
Sheets("Sheet1").Range("A1").Select
End Sub

 

[jevi]

Try this :

Sub emailall()
Dim lRow As Integer
Dim i As Integer
Dim toDate As Date
Dim toList, CCList As String
Dim eSubject As String
Dim eBody As String
Dim OutApp, OutMail


With Application
    .ScreenUpdating = False
    .EnableEvents = False
    .DisplayAlerts = False
End With


Sheets("Sheet1").Select
lRow = Cells(Rows.Count, 2).End(xlUp).Row

Set OutApp = CreateObject("Outlook.Application")

For i = 2 To lRow
  If Cells(i, 3).Value = Date + 15 Then
     Set OutMail = OutApp.CreateItem(0)


        toList = Cells(i, 2)    'gets the recipient from col B
        CCList = Cells(i, 8) & ", " & Cells(i, 9) & ", " & Cells(i, 10)
        eSubject = "You are scheduled for an audit on " & Cells(i, 3) & " at " & Cells(i, 4) & " " & Cells(i, 6)
        eBody = "Greetings : " & vbCrLf & vbCrLf & "Scheduled audit is upcoming on the date indicated above."
       
        On Error Resume Next
        With OutMail
        .To = toList
        .CC = CCList
        .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
 Cells(i, 12) = "Mail Sent " & Date + Time 'Marks the row as "email sent in Column A"
End If
Next i

Set OutApp = Nothing

ActiveWorkbook.Save


With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .DisplayAlerts = True
End With
Sheets("Sheet1").Range("A1").Select
End Sub

Thank you so much Logit. I will try tomorrow at work and give you the feedback as in the office I have outlook while at home I use gmail. So I see it works only with Outlook as I asked and can't try it with gmail Set OutApp = CreateObject("Outlook.Application").

 

[jevi]

Hi Logit,

I did try it today but nothings happens...it says when I run the macro in "esecution" but I don't receive any email. It doesn't also an error message. Maybe it takes some time to get the email as I am using outlook just from some days?

Thank you

 

[Logit]

Did you edit the macro code to match your email address and other specifics ?

 

[jevi]

Yes I did....maybe I need to change this set "Set OutApp = CreateObject("Outlook.Application")" to the right App of Outlook. I will check it with my IT.