Hi, I'm looking for some advice on my code below - I'm new to VBA and have a scenario where I would like to email clients when their licence is due to expire in 90 days and also if it has expired. I found this code on another thread which sends the email however, it's not picking up the 90 day criteria. I'm also looking to see if it's possible to add an extract of the row range into the email body?
Column "E" is the person's name, "F' is the email address and column "BM" is the expiry date. I would very much appreciate any help. Thanks
Column "E" is the person's name, "F' is the email address and column "BM" is the expiry date. I would very much appreciate any help. Thanks
VBA Code:
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 OutApp = CreateObject("Outlook.Application")
For Each cell In Columns("F").Cells.SpecialCells(xlCellTypeConstants)
If cell.Value Like "*@*" Then
If cell.Value <> "" Then
Subj = "Licence Due"
Recipient = cell.Offset(0, -1).Value
EmailAddr = cell.Value
ExpiryDate = Format(cell.Offset(0, 59).Value, "dd/mm/yy")
MailDte = DateAdd("d", -90, ExpiryDate)
If Date >= MailDte And cell.Offset(0, 59).Interior.ColorIndex = xlNone Then
Mail = True
Else
If Mail = True Then
cell.Offset(0, 59).Interior.ColorIndex = 36
End If
Msg = "Dear " & Recipient & "," & vbCrLf & vbCrLf
Msg = Msg & "Your Licence is due to expire on: " & vbCrLf & vbCrLf
Msg = Msg & ExpiryDate & 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 & "" & vbCrLf
Msg = Msg & ""
Set MItem = OutApp.CreateItem(olMailItem)
With MItem
.To = EmailAddr
.Subject = Subj
.body = Msg
.Display
.Send
End With
End If
End If
End If
Next
End Sub