Expiry dates - to send automated emails

I have a lot of employees, with sensitive information that has expiry dates. to keep on top of all of this I would like to know if it is possible to send an automated email using the email addresses in the B column and while keeping myself CC'd in 60 days before it expires and 10 days prior as an urgent attention required. if possible I would like this to be able to be complete without the spread sheet being open.

Ideally the information in the email will have;

URGENT ATTENTION FOR (LINE MANAGER)
Employee - (surname) (first name) has got his (whatever is due for expiry from row 6) coming up for its expiry date

Any issues please contact your supervisor

I have attached a sample spread sheet with how I have it set up at the moment - conditional formatting to highlight in red expired and amber 60 days before problem is im not always in the office to keep on top of this information.

I use Excel 2010 and outlook.

Any help would be greatly appreciated.

Hello fellow Brightonian!

I use this at my work below. Some parts may need amending to your needs. This isn't possible without Excel open unless you have a personalworkook thats coded to autostart with huge amounts of arrays holding data. Anyhow, outlook VBA may be easier to work with for that if its vital.

Sub SetRecipients()
Dim aOutlook As Object
Dim aEmail As Object
Dim rngeAddresses As Range, rngeCell As Range, strRecipients As String

Set aOutlook = CreateObject("Outlook.Application")
Set aEmail = aOutlook.CreateItem(0)
Set rngeAddresses = ActiveSheet.Range("B3:B13")

For Each rngeCell In rngeAddresses.Cells
strRecipients = strRecipients & ";" & rngeCell.Value
Next

aEmail.Importance = 2 ' eg
aEmail.Subject = "(TestMail)"
aEmail.Body = "(TestSubject)"
aEmail.ATTACHMENTS.Add 'try document path
aEmail.To = strRecipients

aEmail.Send

End Sub

Hello thanks for the quick reply fellow Brightonian!

Surely this cant be the amount of code I need I tried my own but it was getting awfully complicated and didn't work lol

Yes, sending the e-mail is relatively simple. The hardest bit will is data validation and calculations to find the which is @ -60 days

Set a few of the dates in your workbook to around April and it will pick them up and send an e-mail off (make sure you have your e-mail in the cells when testing it)

I've put some tests and it send emails. I've put some minor error traps in there for missing data but you may need more.

I recommend the John Walkenbach (think thats his name) Excel VBA programming book if you are getting started, its certainly helped me. As also the help received on this forum!

Heres something that should get you started, place it in a Module -

Public fail As Boolean

Sub Ping(Direct As String, firstn As String, secondn As String, Expdata As String, linem As String)

Dim aOutlook As Object
Dim aEmail As Object
Set aOutlook = CreateObject("Outlook.Application")
Set aEmail = aOutlook.CreateItem(0)

If Direct = "" Then
    MsgBox "No email address supplied, cannot continue" & vbNewLine & Expdata, vbExclamation
    GoTo Errh1
End If

If firstn = "" Then If Not MsgBox("No first name given, continue?" & vbNewLine & Expdata _
, vbYesNo + vbQuestion) = vbYes Then GoTo Errh1 Else
If secondn = "" Then If Not MsgBox("No second name given, continue?" & vbNewLine & Expdata _
, vbYesNo + vbQuestion) = vbYes Then GoTo Errh1 Else
If Expdata = "" Then If Not MsgBox("No expiration data given, continue?" & vbNewLine & Expdata _
, vbYesNo + vbQuestion) = vbYes Then GoTo Errh1 Else
If linem = "" Then If Not MsgBox("No line manager data given, continue?" & vbNewLine & Expdata _
, vbYesNo + vbQuestion) = vbYes Then GoTo Errh1 Else


aEmail.To = Chr(32) & Direct & Chr(32)        'use your email address   when testing
aEmail.Subject = "URGENT ATTENTION FOR " & linem & " - Expiration of certificate"
aEmail.Body = "Employee - " & firstn & " " & secondn & " has " & Expdata & _
" expiring soon" & vbCrLf & vbCrLf & "Any issues please contact your supervisor"
aEmail.cc = "your@e-address.com"         'enter you e-mail address here

aEmail.Send

Exit Sub

Errh1:
fail = True
End Sub

Sub ExpirationAnalysis()

Dim eAddress As String
Dim fName As String
Dim sName As String
Dim ExpirationData As String
Dim LineManager As String
Dim MyDate As Date

MyDate = Date

Dim TestRange As Range
Dim c As Variant

Set TestRange = ActiveSheet.Range("G7:T13") ' this is the range of dates/ data it will be testing for the 60 day difference

For Each c In TestRange
    If IsDate(c.Value) = True Then
        If DateValue(c.Value) - MyDate <= 60 And DateValue(c.Value) - MyDate >= 0 Then
            eAddress = Range("B" & c.Row).Value
            fName = Range("D" & c.Row).Value
            sName = Range("C" & c.Row).Value
            ExpirationData = Cells(6, c.Column).Value
            LineManager = Range("A" & c.Row).Value
            
                Call Ping(eAddress, fName, sName, ExpirationData, LineManager)
                c.Interior.Color = vbGreen
                
                        If fail = True Then
                            c.Interior.Color = vbCyan
                            fail = False
                        End If
                        
            eAddress = ""
            fName = ""
            sName = ""
            ExpirationData = ""
            LineManager = ""
            
        End If
    End If
Next c

End Sub

Thanks again for the quick reply! Gonna have a go tomorrow and see if a simpleton like me can get it working

No probs, the VBA lingo can be quite overwhelming at first but keep at it!

(Just a few notes I thought of -

You'll need to figure out a way to STOP the re-sending of information/ e-mails, maybe a test on interior.color of a cell - Its currently set to VbGreen if it's already sent . Also To trigger this sub on opening of the workbook, add the code below into 'ThisWorkbook'

Private Sub Workbook_Open()

Call ExpirationAnalysis

End Sub

)