Automatically send recurring email

[klg]

Hi there,

I would like to send a birthday email automatically. I found a webpage with instructions where an email gets sent when you dismiss the reminder, but the code doesn't work and the author doesn't seem to be responding. Here is the link https://www.extendoffice.com/documents/outlook/1567-outlook-send-schedule-recurring-email.html

Here the code, I cannot get the email to send. The reminder pop's up, but doesn't send.

Private Sub Application_Reminder(ByVal Item As Object)
Dim xMailItem As MailItem
On Error Resume Next
If Item.Class <> OlObjectClass.olAppointment Then Exit Sub
If Item.Categories <> "Send Schedule Recurring Email" Then Exit Sub
Set xMailItem = Outlook.Application.CreateItem(olMailItem)
With xMailItem
.To = Item.Location
.Subject = Item.Subject
.Body = Item.Body
.Send
End With
Set xMailItem = Nothing
End Sub

[Logit]

.
This resource is EVERYTHING you will ever want or need to know about sending email via VBA.

Look it over. Come back when you have questions.

Here is one example of a scheduled email :



Option Explicit
Sub eMail()
Dim lRow As Integer
Dim i As Integer
Dim toDate As Date
Dim toList As String
Dim eSubject As String
Dim eBody As String
Dim OutApp
Dim OutMail


With Application
.ScreenUpdating = False
.EnableEvents = False
.DisplayAlerts = False
End With


Sheets(1).Select
lRow = Cells(Rows.Count, 1).End(xlUp).Row


For i = 2 To lRow
toDate = Sheets("Sheet1").Cells(i, 1)


If toDate < Date Then: Exit Sub


If Left(Cells(i, 3), 4) <> "Mail" And toDate = Date Then '

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

toList = Cells(i, 2) 'gets the recipient from col B
eSubject = "Happy Birthday !" 'enter subject title here
eBody = "Just taking a moment to wish you a very Happy Birthday !" & vbCrLf & "Hope it's a good day !"

'enter email body here

On Error Resume Next
With OutMail
.To = toList
.CC = ""
.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
Set OutApp = Nothing
Cells(i, 3) = "Mail Sent " & Date + Time 'Marks the row as "email sent in Column C"

End If
Next i
ActiveWorkbook.Save


With Application
.ScreenUpdating = True
.EnableEvents = True
.DisplayAlerts = True
End With
MsgBox "All emails have been sent. ", vbInformation, "Email Notice "


End Sub