A member of our Outlook-Users mailing list prepares birthday greetings ahead of time and sets them for deferred delivery.
My personal preference would be to use the macro at Send an email when an Appointment reminder fires because I am truly lazy (as any good Lazy Programmer should be :)) and could compose the message in the appointment and the time stamp would be on the birthday, not when I sent it to the Outbox. Plus, I would not be annoyed by the "you have unsent messages, do you really want to close Outlook" messages.
But that is just me... and this macro could be the basis for other useful purposes. You can use similar techniques to send contact data to Word documents or Merge to email using only Outlook, which uses bookmarks in a template to place the merge fields.
To change the "default" deferral time, see Set a default 'Do not Deliver before' time. While you can't change the default within Outlook, you can use VBA to set the deferral time automatically.
The code calculates the deferral date based on this year (Now) but checks to see if the birthday is in the past and if so, adds a year to the date. This will allow you to create the messages in December for January birthdays. If you always prepare the messages no more than 30 days prior to the birthday, you could use the following instead of the If bday < Now() Then block.
bday = DateSerial(Year(Now +30), Month(oContact.Birthday), Day(oContact.Birthday))
To customize the message or subject with the person's first name, use oContact.FirstName
objMsg.Subject = "Happy Birthday, " & oContact.FirstName
Defer delivery until a Contact's birthday
To use, open the VBA Editor using Alt+F11 and add this code to the ThisOutlookSession then create a toolbar button or ribbon command for it.
Select the contact and run the macro. A message form opens, addressed to the contact, set for deferred delivery as of 6 AM on the day of their birthday. You can either use objMsg.Display to display the message and add a note to it or use objMsg.Send to send it to the Outbox automatically.
Public Sub SendDeferredBirthdayGreetings() Dim bday If TypeName(ActiveExplorer.Selection.Item(1)) = "ContactItem" Then Set oContact = ActiveExplorer.Selection.Item(1) 'uses "this" year bday = DateSerial(Year(Now), Month(oContact.Birthday), Day(oContact.Birthday)) If bday < Now() Then 'add 1 year bday = DateSerial(Year(Now) + 1, Month(oContact.Birthday), Day(oContact.Birthday)) Else bday = bday + 0.25 ' sets it for 6 am the day of the birthday End If Dim objMsg As MailItem Set objMsg = Application.CreateItem(olMailItem) objMsg.To = oContact.Email1Address objMsg.Subject = "Happy Birthday" objMsg.Body = "Hope your day is a happy one!" objMsg.DeferredDeliveryTime = bday 'displays the message form so you can enter more text objMsg.Display 'use this to send to outbox 'objMsg.Send Set objMsg = Nothing Else MsgBox "Sorry, you need to select a contact" End If End Sub
Check all contacts for upcoming birthdays
This version of the code checks the selected contacts folder for upcoming birthdays (next 7 days) and prepares a Happy Birthday message, to be sent the morning of their birthday.
To use, select a contacts folder and run the macro. If you only have one contacts folder or only want to use it on the default folder, uncomment this line that uses the default folder: Set objFolder = objOL.Session.GetDefaultFolder(olFolderContacts)
. (If you use the default folder, you can remove the If then else lines that check the folder type.)
Dim bday Dim objOL As Outlook.Application Dim objItems As Outlook.Items Dim objFolder As Outlook.MAPIFolder Dim obj As Object Set objOL = Outlook.Application ' Use any contacts folder Set objFolder = objOL.ActiveExplorer.currentFolder ' Use default contacts 'Set objFolder = objOL.Session.GetDefaultFolder(olFolderContacts) Set objItems = objFolder.Items For Each obj In objItems If TypeName(obj) = "ContactItem" Then Set oContact = obj 'uses "this" year bday = DateSerial(Year(Date), Month(oContact.Birthday), Day(oContact.Birthday)) ' check for upcoming birthdays this week If bday > Date + 1 And bday < Date + 7 Then Debug.Print bday ' check for email address If oContact.Email1Address = "" Then GoTo nextrecord bday = bday + 0.25 ' sets it for 6 am the day of the birthday Dim objMsg As MailItem Set objMsg = Application.CreateItem(olMailItem) objMsg.To = oContact.Email1Address objMsg.Subject = "Happy Birthday" objMsg.Body = "Hope your day is a happy one!" objMsg.DeferredDeliveryTime = bday 'displays the message form so you can enter more text objMsg.Display 'use this to send to outbox 'objMsg.Send Set objMsg = Nothing End If Else MsgBox "You need to select a Contacts folder before running the macro." Exit Sub End If nextrecord: Next End Sub
Calculate the Contact's Age
You can calculate the contact's age and add it to the message or subject. (Do so at your own risk. :))
This requires you have the correct birth year in contacts.
age = DateDiff("yyyy", oContact.Birthday, bday) objMsg.To = oContact.Email1Address objMsg.Subject = "Happy " & age & " Birthday" objMsg.Body = "Hope your day is a happy one! May you enjoy the next " & age & " years as much as the last " & age & "!"
To convert the date to ordinal format (14th, 33rd, etc), after you get the age, use select case to convert it to the ordinal format, then use it in the subject or body code.
Select Case CLng(Right(age, 1)) Case 1 OrdinalAge = age & "st" Case 2 OrdinalAge = age & "nd" Case 3 OrdinalAge = age & "rd" Case Else OrdinalAge = age & "th" End Select
To account for the 3 that are different... check if 11, 12, or 13:
Select Case CLng(Right(age, 2)) Case 11, 12, 13 OrdinalAge = age & "th" End Select
Put together, it looks like this and replaces the code block in the macro that begins and ends with the same lines.
bday = bday + 0.25 ' sets it for 6 am the day of the birthday age = DateDiff("yyyy", oContact.Birthday, bday) Select Case CLng(Right(age, 1)) Case 1 OrdinalAge = age & "st" Case 2 OrdinalAge = age & "nd" Case 3 OrdinalAge = age & "rd" Case Else OrdinalAge = age & "th" End Select Select Case CLng(Right(age, 2)) Case 11, 12, 13 OrdinalAge = age & "th" End Select Debug.Print age, OrdinalAge Dim objMsg As MailItem Set objMsg = Application.CreateItem(olMailItem) objMsg.To = oContact.Email1Address objMsg.Subject = "Happy " & OrdinalAge & " Birthday" objMsg.Body = "Hope your day is a happy one! May you enjoy the next " & age & " years as much as the last " & age & "!" objMsg.DeferredDeliveryTime = bday 'displays the message form so you can enter more text objMsg.Display
Use a Template
If you want to use a template, you need to replace the Set objMsg = Application.CreateItem(olMailItem) line with
Set objMsg = Application.CreateItemFromTemplate("C:\path\to\birthday-wishes.oft")
and remove the objMsg.Body line that adds text to the body. If you want to add a personalized first line and the template text, add & objMsg.Body to the end of the line so it copies the template text, like this:
objMsg.Body = "Hope your day is a happy one " oContact.FirstName & "!" & objMsg.body
How do you want me to send the template to you? But here is my code with comments 'https://www.slipstick.com/developer/create-deferred-birthday-message-contact/ Public Sub SendDeferredBirthdayGreetings() Dim bday If TypeName(ActiveExplorer.Selection.Item(1)) = "ContactItem" Then Set oContact = ActiveExplorer.Selection.Item(1) 'uses "this" year bday = DateSerial(Year(Now), Month(oContact.Birthday), Day(oContact.Birthday)) If bday < Now() Then 'add 1 year bday = DateSerial(Year(Now) + 1, Month(oContact.Birthday), Day(oContact.Birthday)) Else bday = bday + 0.22 ' sets it for 6 am the day of the birthday End If Dim objMsg As MailItem 'Set objMsg = Application.CreateItem(olMailItem) Set objMsg = Application.CreateItemFromTemplate("C:Documents and SettingsJim WagnerApplication DataMicrosoftTemplatesHappy Birthday.oft") age = DateDiff("yyyy", oContact.Birthday, bday) objMsg.To = oContact.Email1Address objMsg.Subject = "Happy Birthday, " & oContact.FirstName objMsg.Body = oContact.FirstName & "!" & objMsg.Body 'objMsg.Subject = "Happy Birthday " 'objMsg.Body = "Hope your day is a happy one!" 'objMsg.Subject = "Happy " & age & " Birthday" ' objMsg.Body = "Hope your day is a happy one! May you enjoy the next " & age & " years as much as the last " & age & "!" objMsg.DeferredDeliveryTime = bday objMsg.Display 'displays the message form so you can enter more text objMsg.Display 'use this to send to outbox 'objMsg.Send Set objMsg = Nothing Else MsgBox "Sorry, you need to… Read more »
I figured you had my address - use diane at slipstick and send it as an attachment.
So the objMsg.Body will be difficult. I currently have in the template the below message.
The HAPPY BIRTHDAY is in red bold Arial 26 font. How would I change that to be the same. I am using html. I create a new birthday card every year and anniversary card so it is different all the time. It has become a labor of fun, but a true time consuming project. I do not mind the time because people really enjoy the card. It actually brings me great joy.
John
HAPPY BIRTHDAY
*see attachment
Jim Wagner
You'll need to email me the template by the looks of it. You have two options: my preference would be to use the template and remove the objMsg.body line - add the person's name in the subject to personalize it and use the template as the message. The second option is to add the entire message and HTML code in the body line. The first is easier...
I love this.
How do I incorporate the name in the code to say objMsg.Subject = "Happy Birthday & " " & [First Name]"
Or how do I use my birthday email template to use instead of a new message.
Thank You
Jim Wagner
sure - use objMsg.Subject = "Happy Birthday, " & oContact.FirstName
To use a template, replace the Set objMsg = Application.CreateItem(olMailItem) line with
Set objMsg = Application.CreateItemFromTemplate("C:\path\to\birthday-wishes.oft") and remove the line that adds text to the body -- or change it to something like objMsg.Body = "Hope your day is a happy one " oContact.FirstName & "!" & objMsg.body so it copies the template text.