Creating message if Contact's birthday is today

**ElmerS** · 04-22-2009, 04:26 AM

Hi,

I found this piece of code on the web.

http://help.lockergnome.com/office/C...ct1002097.html

Its purpose is to send a short greeting to every contact if his/her Birthday falls within today.

The problematic line is: BD = oCurItem.Birthday
(I added it to see the birthday date by placing the curson on it)

After 2-3 Loop cycles I get a 438 error: "...does not support this property" and BD shows: 01/01/4501

What did I do wrong ?

Code:

Sub getContacts()
Dim olns As Outlook.NameSpace
Dim oConItems As Outlook.Items
Set ol = New Outlook.Application
Set olns = ol.GetNamespace("MAPI")
Set oConItems = olns.GetDefaultFolder(olFolderContacts).Items
  Flag = 0
  For Each oCurItem In oConItems
    BD = oCurItem.Birthday ''''''''''''' ???
    If oCurItem.Birthday = Date Then
        Dim msg As Outlook.MailItem
        Set msg = Application.CreateItem(olMailItem)
        msg.Subject = "Happy Birthday"
        msg.Address = objContactItem.Email1Address
        msg.Display
        Set msg = Nothing
        Flag = Flag + 1
    End If
  Next
  If Flag = 0 Then MsgBox "No Birthdays Today"
End Sub

Thanks,
Elm

**ExlGuru** · 04-22-2009, 06:04 AM

WScript is unknown. Replace WSCript.Echo by MsgBox.

It the code runs within Outlook then delete the Set ol = New ... line, and
replace ol.GetNameSpace by Application.GetNamespace.

You do not set any date to the today variable, so the value is 0. The Date
function would return the current date.

If you want one message be displayed if there's no birthday today at all
then use another variable declared As Boolean. If one birthday is found then
set it = True. Eventually, if the variable is still False (inital value)
then you know that it never was set to True, i.e. no birthday.

**ElmerS** · 04-22-2009, 06:13 AM

Hi,

This is a very nice "copying job" of Michael Bauers reply at the site where I found the code.

If you'll look a little bit closer you'll probably see that I "obeyed" all proposed instructions but, as said before, it still "does not supply the merchandise".

Could you check the code on your computer to see how it acts there.
If any additional modification is needed - I will appreciate if you'll take care of them.

Any other VBA code providing the requested task (NO third-party software) will be appreciated.

Thanks, Elm

**ExlGuru** · 04-22-2009, 06:45 AM

Elmers it was mistakenly send to you it was not actually for you, that is the solution for L_ter's Question.So please don't be worry.I m trying to find out the solution for you.

Thanks.

**ElmerS** · 04-22-2009, 06:52 AM

Thanks, ExlGuru

I'll wait "Impatiently" for a decent result...

Elm

**ExlGuru** · 04-22-2009, 07:15 AM

By this code you are able to set the remainder .You have to set a remainder to the outlook.

Elmers try this code:

Hope it helps:

Code:

Dim WithEvents mcolCalItems As Items

Private Sub Application_Startup()
    Dim objNS As NameSpace
    Set objNS = Application.GetNamespace("MAPI")
    Set mcolCalItems = objNS.GetDefaultFolder(olFolderCalendar).Items
    Set objNS = Nothing 
End Sub 

Private Sub mcolCalItems_ItemAdd(ByVal Item As Object)
    ' #### USER OPTIONS ####
    ' remind me of birthdays XX days before
    intDays = 14

    If Item.Class = olAppointment And _
       InStr(Item.Subject, "Birthday") > 0 Then
        With Item
            .ReminderSet = True
            .ReminderMinutesBeforeStart = 24 * 60 * intDays
            .Save
        End With
    End If
End Sub

**ElmerS** · 04-22-2009, 08:02 AM

Sotty, but now I lost you completely and could not find my way through your last codes.

My request goes like that:

When I manually, add/mark a contacts birthday - it becomes an Annually Recurrent Event with a reminder.

So far so good.

What I need is a code that will open/display a new mail message with some pre-defined blessing.

I will press send after examining the 'to-be sent' message.
[If there are 3 contacts whose Birthday falls on the same date - 3 new messages will be generated and opened - each for every contact.

That is all I need.

Thanks, Elm

**ShredDude** · 05-23-2009, 02:36 AM

I believe you'd be getting the error you're getting if the contact being processed is not an individual contact, but perhaps a distribution list, which does not have a Birthday property.

Try inserting a test to confirm that the contact being processed is a "Contact", with something like this:

Code:

if ocuritem.class=40 then '40=olcontact
       ' Check Birthday, etc...
Else
      ' Not an individual contact, no Birthday property
end if

Or, trap the error when you query the birthday property and it doesn't work.

**ElmerS** · 05-25-2009, 05:10 PM

Hi,

Thanks to all who repliers up to now.

Here is the code I came up with/

Please note the two command which provide a "run-time error 424" if one, or, more recipients have Birthday - today..

Where did I go wrong and what can be done to correct it !?

Thanks, Elm

Code:

Sub GetContacts()
' Dim Today As Date
Dim olns As Outlook.NameSpace
Dim oConItems As Outlook.Items
Set ol = New Outlook.Application
Set olns = ol.GetNamespace("MAPI")
Set oConItems = olns.GetDefaultFolder(olFolderContacts).Items
Flag = 0
For Each ocuritem In oConItems
'If oCurItem.Birthday = today Then
'=========== 23/5/2009 =====================
'http://www.excelforum.com/outlook-programming/680678-creating-message-if-contacts-birthday-is-today.html#post2098103
  If ocuritem.Class = 40 Then ' 40=olcontact
  ' Check Birthday, etc...
  ' BD = ocuritem.Birthday
    If ocuritem.Birthday = Date Then
        Dim msg As Outlook.MailItem
        Set msg = Application.CreateItem(olMailItem)
        msg.Subject = "Happy Birthday"
        msg.Address = ocuritem.Email1Address  ''' run- time error 424
        msg.Address = objContactItem.Email1Address  ''' run- time error 424
        msg.Display
        Set msg = Nothing
        Flag = Flag + 1
    End If
'Else
   ' Not an individual contact, no Birthday property
  End If
Next
If Flag = 0 Then MsgBox "No Birthdays Today"
End Sub