Automatically send email from excel file due date to outlook

jevi

Active Member
Joined
Apr 13, 2010
Messages
281
Office Version
  1. 2016
Platform
  1. Windows
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

ABCDEFG
1Contract TypeDescriptionDate of ContractDue toAlertEmail to
2
Maintenance Webex​
Technical administration​
10/01/2020​
30/09/2021​
TRUE
3
Utility​
Electricity, water​
01/02/2019​
05/11/2021​
FALSE

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

Excel Facts

Quick Sum
Select a range of cells. The total appears in bottom right of Excel screen. Right-click total to add Max, Min, Count, Average.

Logit

Well-known Member
Joined
Aug 31, 2016
Messages
4,317
Try this :

VBA Code:
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
 

Attachments

  • Email.jpg
    Email.jpg
    174.7 KB · Views: 34

jevi

Active Member
Joined
Apr 13, 2010
Messages
281
Office Version
  1. 2016
Platform
  1. Windows
Try this :

VBA Code:
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

Active Member
Joined
Apr 13, 2010
Messages
281
Office Version
  1. 2016
Platform
  1. Windows
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

Well-known Member
Joined
Aug 31, 2016
Messages
4,317
Did you edit the macro code to match your email address and other specifics ?
 

jevi

Active Member
Joined
Apr 13, 2010
Messages
281
Office Version
  1. 2016
Platform
  1. Windows
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.
 
Learn Excel from Bill Jelen

Understanding data is crucial, and the easiest place to start is with Microsoft Excel.

Forum statistics

Threads
1,151,699
Messages
5,766,001
Members
425,322
Latest member
galaxy6623top

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top