VBA send email based on date in Cell using info in excel cells

[kizzie37]

I tried looking for a solution but couldn't find anything that I could stitch together from prior posts to match my needs. Unfortunately my security will not allow me to use the screen capture tool so I can only provide a picture.

I have a spreadsheet of new employees, their names, manager name and email and their hire date. at 30, 60 and 90 days of their tenure I would like a email to be sent from my spreadsheet to the manager to remind them to check in with the employee (complete wording yet TBD).

The 30, 60 & 90 day dates are established on the Spreadsheet via formula.

I would like help to compile a macro that will send an email the day after the 30, 60 90 day due date (just the day after so only once) to the manager email, the message will contain information from the sheet itself (se below). I assume this can be triggered by opening the spreadsheet each day?

The wording of the email needs to be compiled and might contain several lines so I would need to know how to space out multiple lines. but the gist will be

"Dear <Manager>

Your recently hired employee <Employee Name> has now reached their <30/60/90> day tenure with the company. Please ensure that you connect with them ASAP to conduct a formal check in with them.

Please reach out if you have any questions"

Below is a screenshot example of my sheet (there are more columns after those shown, but are not relevant to the macro)

Thanks in advance for your assistance

 

[daverunt]

Hi,

I put this together from a similar post I answered a while ago. There may be lots of different and slicker ways to do this but you have something to work with.

Send email based on date

Hello All, I am hoping someone can help me here. I am using the code below to send an email in outlook from excel. The general idea is that the sheet would have people's names in columns A&B, email address in column C, and the date that their training is due in column D. What I would like to...

www.mrexcel.com

It just triplicates the checks as there are 3 columns to look at in your sheet.
I have just used cell offsets from the 30day column to check the other 2 columns.
It highlights the cell when the mail has been sent or more accurately when it deems mail to be sent is True.
It then checks that colour so that it doesn't send the same mail twice.
It saves the workbook so the colour changes are kept.
It will send the mail anytime after the mail date not on Date + 1 day as you might have a valid date to send that coincides with a Weekend?
I needed a reference to which date it was using mail30 60 or 90 in order to get the column header for the tenure day in the mail body.

You can open it with a WorkbookOpen event
You can create a Task in Task Scheduler to launch a BAT file on your Desktop the same time every day, that calls the Excel File and thus triggers the WorkbookOpen and any subsequent mail

There are no sheet references, you might need to add some if necessary.

Dim OutApp As Object
Dim OutMail As Object
Dim EmailSubject As String
Dim EmailSendTo As String
Dim MailBody As String
 
'Private Sub Workbook_Open()
Sub Mail_testing()

Mail30 = False
Mail60 = False
Mail90 = False

Set Rng = Range(Range("E2"), Range("E" & Rows.Count).End(xlUp))
      
For Each cell In Rng
If cell.Value <> "" Then

'Activate cell so you can get address and colour if required
    cell.Activate
    CA = cell.Address(0, 0)
    dte30 = Range(CA).Value
    dte60 = Range(CA).Offset(0, 1).Value
    dte90 = Range(CA).Offset(0, 2).Value
        
    MailDte30 = DateAdd("d", 1, dte30)
    MailDte60 = DateAdd("d", 1, dte60)
    MailDte90 = DateAdd("d", 1, dte90)
   
    If Date >= MailDte30 And ActiveCell.Interior.ColorIndex = xlNone Then
        Mail30 = True
    If Mail30 = True Then
        TenureDate = Range("E1").Value
        ActiveCell.Interior.ColorIndex = 36
    End If
    End If
    If Date >= MailDte60 And ActiveCell.Offset(0, 1).Interior.ColorIndex = xlNone Then
        Mail60 = True
    If Mail60 = True Then
        TenureDate = Range("E1").Offset(0, 1).Value
        ActiveCell.Offset(0, 1).Interior.ColorIndex = 36
    End If
    End If
    If Date >= MailDte90 And ActiveCell.Offset(0, 2).Interior.ColorIndex = xlNone Then
        Mail90 = True
    If Mail90 = True Then
        TenureDate = Range("E1").Offset(0, 2).Value
        ActiveCell.Offset(0, 2).Interior.ColorIndex = 36
    End If
    End If
    
    
    
    If Mail30 Or Mail60 Or Mail90 = True Then
    
'Mail Body
    MailBody = "Dear " & ActiveCell.Offset(0, -2).Value & vbNewLine & vbNewLine _
    & "Your recently hired employee " & ActiveCell.Offset(0, -3).Value & " has now reached their " _
    & TenureDate & " tenure with the company. Please ensure that you connect with them ASAP to conduct a formal check in with them." _
    & vbNewLine & "Please reach out if you have any questions"
    

'Subject string
    EmailSubject = "Put the subject here"
    EmailSendTo = cell.Offset(0, -1) ' Column D

 
'Send Mail
        Set OutApp = CreateObject("Outlook.Application")
        Set OutMail = OutApp.CreateItem(o)
        With OutMail
            .Subject = EmailSubject
            .To = EmailSendTo
            '.bcc
            .body = MailBody
            .Display
            '.send
        End With
 
        Set OutMail = Nothing
        Set OutApp = Nothing
        
        Mail30 = False
        Mail60 = False
        Mail90 = False
        TenureDate = ""
    End If
    End If
Next
'Put in so colour changes saved, mail won't be sent again on open/run
'ActiveWorkbook.Close SaveChanges:=True
End Sub

 

[kizzie37]

Hello, thank you! this works great I have a couple questions

It creates the emails, but I have to manually click the "Send" button - is there a way to automatically send?

And how would I do these? (sorry not a programmer I just dabble in some light macro stuff)

• You can open it with a WorkbookOpen event
• You can create a Task in Task Scheduler to launch a BAT file on your Desktop the same time every day, that calls the Excel File and thus triggers the WorkbookOpen and any subsequent mail

Oh and how can I append my signature?

 

[kizzie37]

Hi,

I put this together from a similar post I answered a while ago. There may be lots of different and slicker ways to do this but you have something to work with.

Send email based on date

Hello All, I am hoping someone can help me here. I am using the code below to send an email in outlook from excel. The general idea is that the sheet would have people's names in columns A&B, email address in column C, and the date that their training is due in column D. What I would like to...

www.mrexcel.com

It just triplicates the checks as there are 3 columns to look at in your sheet.
I have just used cell offsets from the 30day column to check the other 2 columns.
It highlights the cell when the mail has been sent or more accurately when it deems mail to be sent is True.
It then checks that colour so that it doesn't send the same mail twice.
It saves the workbook so the colour changes are kept.
It will send the mail anytime after the mail date not on Date + 1 day as you might have a valid date to send that coincides with a Weekend?
I needed a reference to which date it was using mail30 60 or 90 in order to get the column header for the tenure day in the mail body.

You can open it with a WorkbookOpen event
You can create a Task in Task Scheduler to launch a BAT file on your Desktop the same time every day, that calls the Excel File and thus triggers the WorkbookOpen and any subsequent mail

There are no sheet references, you might need to add some if necessary.

Dim OutApp As Object
Dim OutMail As Object
Dim EmailSubject As String
Dim EmailSendTo As String
Dim MailBody As String
 
'Private Sub Workbook_Open()
Sub Mail_testing()

Mail30 = False
Mail60 = False
Mail90 = False

Set Rng = Range(Range("E2"), Range("E" & Rows.Count).End(xlUp))
     
For Each cell In Rng
If cell.Value <> "" Then

'Activate cell so you can get address and colour if required
    cell.Activate
    CA = cell.Address(0, 0)
    dte30 = Range(CA).Value
    dte60 = Range(CA).Offset(0, 1).Value
    dte90 = Range(CA).Offset(0, 2).Value
       
    MailDte30 = DateAdd("d", 1, dte30)
    MailDte60 = DateAdd("d", 1, dte60)
    MailDte90 = DateAdd("d", 1, dte90)
  
    If Date >= MailDte30 And ActiveCell.Interior.ColorIndex = xlNone Then
        Mail30 = True
    If Mail30 = True Then
        TenureDate = Range("E1").Value
        ActiveCell.Interior.ColorIndex = 36
    End If
    End If
    If Date >= MailDte60 And ActiveCell.Offset(0, 1).Interior.ColorIndex = xlNone Then
        Mail60 = True
    If Mail60 = True Then
        TenureDate = Range("E1").Offset(0, 1).Value
        ActiveCell.Offset(0, 1).Interior.ColorIndex = 36
    End If
    End If
    If Date >= MailDte90 And ActiveCell.Offset(0, 2).Interior.ColorIndex = xlNone Then
        Mail90 = True
    If Mail90 = True Then
        TenureDate = Range("E1").Offset(0, 2).Value
        ActiveCell.Offset(0, 2).Interior.ColorIndex = 36
    End If
    End If
   
   
   
    If Mail30 Or Mail60 Or Mail90 = True Then
   
'Mail Body
    MailBody = "Dear " & ActiveCell.Offset(0, -2).Value & vbNewLine & vbNewLine _
    & "Your recently hired employee " & ActiveCell.Offset(0, -3).Value & " has now reached their " _
    & TenureDate & " tenure with the company. Please ensure that you connect with them ASAP to conduct a formal check in with them." _
    & vbNewLine & "Please reach out if you have any questions"
   

'Subject string
    EmailSubject = "Put the subject here"
    EmailSendTo = cell.Offset(0, -1) ' Column D

 
'Send Mail
        Set OutApp = CreateObject("Outlook.Application")
        Set OutMail = OutApp.CreateItem(o)
        With OutMail
            .Subject = EmailSubject
            .To = EmailSendTo
            '.bcc
            .body = MailBody
            .Display
            '.send
        End With
 
        Set OutMail = Nothing
        Set OutApp = Nothing
       
        Mail30 = False
        Mail60 = False
        Mail90 = False
        TenureDate = ""
    End If
    End If
Next
'Put in so colour changes saved, mail won't be sent again on open/run
'ActiveWorkbook.Close SaveChanges:=True
End Sub

Hi Dave

So I figured out how to Send and also how to append my signature. Can you assist with how to "create a Task in Task Scheduler to launch a BAT file on your Desktop the same time every day, that calls the Excel File and thus triggers the WorkbookOpen and any subsequent mail" ?

I have no idea on how to achieve that. The sheet sits in a shared drive.

 

[daverunt]

Hi,

Missed the previous post. Busy weekend.
Good that you did the work without any help : )

Have a look at this old post. Not the code, just from the Workbook Open part of the post.

VBA code needed

Hi All, Every day a folder is created with the currendate(ex:=05-jul-2013) as the folder name. I need a code which would automatically every day and every hour of that day to go into the folder and copy all those files into a target folder. Please help me with a vba codeEvery day a folder is...

www.mrexcel.com

A Workbook open event can call your macro. That goes in "ThisWorkbook" in the VBA project
Make sure the macro runs when you manually open the workbook.


Then try and get the BAT file/Task Scheduler bits to work.

I expect you'll have issues calling a file on a shared drive. You might need search for help with that.
I've no idea. Never done it.