Send email based on date

[nuge725]

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 know is if there is a way that I can have an email generated when the date reaches 90 days away from the date in column D. However, since there are about 40 different names on the list, there will be several different dates in column D. Is there a way to send the email only to those who have hit the 90 day criteria, without sending it to everybody on the list? Any help is greatly appreciated, and thank you in advance.

Ryan

Sub SendEmail()    Dim OutlookApp As Outlook.Application
    Dim MItem As Outlook.MailItem
    Dim cell As Range
    Dim Subj As String
    Dim EmailAddr As String
    Dim Recipient As String
    
    Set OutlookApp = New Outlook.Application
    
    For Each cell In Columns("C").Cells.SpecialCells(xlCellTypeConstants)
        If cell.Value Like "*@*" Then
            Subj = "Training Dates"
            Recipient = cell.Offset(0, -2).Value
            EmailAddr = cell.Value
            TrainingDate = Format(cell.Offset(0, 1).Value, "mm/dd/yy")
            
            Msg = "Dear " & Recipient & "," & vbCrLf & vbCrLf
            Msg = Msg & "Your Quarterly Firearms training is due on: " & vbCrLf & vbCrLf
            Msg = Msg & TrainingDate & vbCrLf & vbCrLf
            Msg = Msg & "Please schedule this training with management or the training coordinator." & vbCrLf & vbCrLf
            Msg = Msg & "Thank you," & vbCrLf & vbCrLf
            Msg = Msg & "NAME" & vbCrLf
            Msg = Msg & "TITLE" & vbCrLf
            Msg = Msg & "DEPARTMENT"
            
            Set MItem = OutlookApp.CreateItem(olMailItem)
            With MItem
                .To = EmailAddr
                .Subject = Subj
                .Body = Msg
                .Send
            End With
        End If
    Next
End Sub

 

[daverunt]

Hi,

Try the following.
MailDte is the Training date less 90 days.

When you run the macro it will check the MailDte against the current date.
If MailDte is greater than 90-days no mail is generated.
If the date for mailing is 90 days away or has passed i.e. less than 90-days (might occur if MailDte is passed on a weekend) then it will send out a mail to the specified recipient only and colour the cell at the same time.

The cell colour is also checked with the date so repeat mails are not sent every time the file is opened.

This does require that the file is saved after opening, which I have stuck at the end of the macro.

I have changed .send to .display so I could test mails are generated with appropriate dates in the columns.

Sub SendEmail()
Dim OutlookApp As Outlook.Application
    Dim MItem As Outlook.MailItem
    Dim cell As Range
    Dim Subj As String
    Dim EmailAddr As String
    Dim Recipient As String
    
    Set OutlookApp = New Outlook.Application
    
    For Each cell In Columns("C").Cells.SpecialCells(xlCellTypeConstants)
        If cell.Value Like "*@*" Then
        If cell.Value <> "" Then
        
            Subj = "Training Dates"
            Recipient = cell.Offset(0, -2).Value
            EmailAddr = cell.Value
            
            
            TrainingDate = Format(cell.Offset(0, 1).Value, "mm/dd/yy")
            MailDte = DateAdd("d", -90, TrainingDate)
            If Date >= MailDte And cell.Offset(0, 1).Interior.ColorIndex = xlNone Then
            mail = True
            If mail = True Then
                 cell.Offset(0, 1).Interior.ColorIndex = 36
            End If
            
            Msg = "Dear " & Recipient & "," & vbCrLf & vbCrLf
            Msg = Msg & "Your Quarterly Firearms training is due on: " & vbCrLf & vbCrLf
            Msg = Msg & TrainingDate & vbCrLf & vbCrLf
            Msg = Msg & "Please schedule this training with management or the training coordinator." & vbCrLf & vbCrLf
            Msg = Msg & "Thank you," & vbCrLf & vbCrLf
            Msg = Msg & "NAME" & vbCrLf
            Msg = Msg & "TITLE" & vbCrLf
            Msg = Msg & "DEPARTMENT"
            
            Set MItem = OutlookApp.CreateItem(olMailItem)
            With MItem
                .To = EmailAddr
                .Subject = Subj
                .body = Msg
                .Display
                'Send
            End With
        End If
        End If
        End If
    Next
End Sub

 

[aliaslamy2k]

Hello,
This code is very useful for me. kindly advise where should i paste this code.
Sheet1 or ThisWorkbook or Module 1

Thanks

 

[daverunt]

I can't remember which it was for but as there are no sheets specified it's probably better suited to a sheet.
If you put it in a module at least activate the sheet required at the start of the macro.

 

[Anakin89]

good day,

I am a very basic user and am trying to adapt this code to only send to a single email address based on all data to let a supervisor know 5 days before return. I would like this to be sent out -5 days prior to "End Date" in column J. I also need to know. Please highlight the areas I need to fill in.

I need the email to read:
"Title"
"Member Name (column E+F) returning on (column J)
Thanks,
NAME
Department

Thanks alot,
Mitch