Private Sub Application_Reminder(ByVal Item As Object)
Dim objContacts As Outlook.Items
Dim objItem As Object
Dim objContact As Outlook.ContactItem
Dim strToday As String
Dim strBirthday As String
Dim objGreetingMail As Outlook.MailItem
Dim objWordDocument As Word.Document
If TypeOf Item Is TaskItem And Item.Subject = "Send Birthday Greeting Mail" Then
strToday = Month(Date) & "-" & Day(Date)
Set objContacts = Outlook.Application.Session.GetDefaultFolder(olFolderContacts).Items
For Each objItem In objContacts
If TypeOf objItem Is ContactItem Then
Set objContact = objItem
strBirthday = Month(objContact.Birthday) & "-" & Day(objContact.Birthday)
If strBirthday = strToday Then
'Create the greeting message from a preset template
Set objGreetingMail = Outlook.Application.CreateItemFromTemplate("C:\Users\Test\Documents\UserTemplates\Birthday Greeting Mail.oft")
Set objWordDocument = objGreetingMail.GetInspector.WordEditor
objWordDocument.Range.InsertBefore "Dear " & objContact.LastName & vbCrLf & vbCrLf
'To create a new mail, you can also use:
'Set objgreetingmail = outlook.Application.CreateItem(olMailItem)
With objGreetingMail
.Recipients.Add (objContact.Email1Address)
.Subject = "Happy Birthday!"
.Display
'To directly send
.Close (olSave)
.Send
End With
End If
End If
Next
End If
End Sub