Send a greeting message to a contact on birthday

[gaib]

I found this macro which seems to be reasonably close to what I'm looking for.

Data Recovery, File Recovery and Email Recovery Software by DataNumen

Data recovery tools for Outlook PST/OST files, Access, Excel, Word & PowerPoint files, SQL Server databases, PDF, DWG, BKF, ZIP & RAR files.

www.datanumen.com

My question! How can I just run this macro when I want and it searches the calendar for any birthday's on that particular day?

I don't really want to setup a task for this to fire automatically.

 

[Diane Poremsky]

I have this macro which creates deferred messages - it could easily be tweaked to look for b-days 'today' and send the message.

Create a deferred Birthday message for an Outlook Contact

Use VBA to create a message to a Contact and defer delivery until the morning of their birthday. Use this technique to insert Outlook fields into a new message.

www.slipstick.com

 

[gaib]

Hi Diane and thank you for the help. I was able to get this macro to work by selecting the contact and running the macro, but if not to much trouble, I would love to know how to loop thru the "today" birthday's and display versus send.

 

[Diane Poremsky]

looping the folder is easy - but if you have many contacts, filtering the dates would be faster than looping each contact. I'll take a look at it.

 

[Diane Poremsky]

This will loop through each contact and check for an upcoming birthday then prepare a birthday email that will be sent the morning of their birthday.

Public Sub SendDeferredBirthdayGreetings()

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
    Set objFolder = objOL.ActiveExplorer.currentFolder
    Set objItems = objFolder.Items
 
    For Each obj In objItems


If TypeName(obj) = "ContactItem" Then

 Set oContact = obj
'uses "this" year
 bday = DateSerial(Year(Now), 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

End If

nextrecord:
Next
End Sub

 

[gaib]

This is perfect Diane. Thank you very much.