Code to check Calendar VS Birthdays and Anniversaries

  • Thread starter Thread starter Neal B. Scott
  • Start date Start date
N

Neal B. Scott

I got tired of my calendar being a little out of synch with itself. I
want ALL birthday and ALL anniversaries in my contacts to be in my
calendar, no exceptions. Outlooks seems to handle them as optional on
occasion. Mostly as result of manual data imports. Anyway I wrote
some quicky code to see what bday's and anniversaries are missing from
the calendar and thought it may help someone else out there someday...



Option Explicit
Sub CheckBDayAnniv()
Debug.Print "Searching.."

Dim oOL As Outlook.Application
Set oOL = New Outlook.Application

Dim olns As Outlook.NameSpace
Set olns = oOL.GetNamespace("MAPI")

Dim PersonalFolders As Outlook.MAPIFolder
Set PersonalFolders = olns.Folders("Personal Folders")

Dim ContactFolder As Outlook.MAPIFolder
Set ContactFolder = PersonalFolders.Folders("CONTACTS")
Dim CalendarFolder As Outlook.MAPIFolder
Set CalendarFolder = PersonalFolders.Folders("Calendar")


Dim ContactItems As Outlook.Items 'notice this one is plural
Set ContactItems = ContactFolder.Items

Dim CurItem As Outlook.ContactItem 'and this one is not
Dim i As Integer
For Each CurItem In ContactItems

If CurItem.Birthday > #1/1/1900# And CurItem.Birthday <>
#1/1/4501# Then
Dim BDayFound As Boolean
BDayFound = False


Dim strBDay As String
strBDay = CurItem.Subject & "'s Birthday"

For i = 1 To CalendarFolder.Items.Count
If CalendarFolder.Items(i) = strBDay Then
BDayFound = True
Exit For
End If
Next
If BDayFound = False Then
Debug.Print strBDay
End If
End If
Next

For Each CurItem In ContactItems

If CurItem.Anniversary > #1/1/1900# And CurItem.Anniversary <>
#1/1/4501# Then
Dim AnnFound As Boolean
AnnFound = False

Dim strAnnDay As String
strAnnDay = CurItem.Subject & "'s Anniversary"

For i = 1 To CalendarFolder.Items.Count
If CalendarFolder.Items(i) = strAnnDay Then
AnnFound = True
Exit For
End If
Next
If AnnFound = False Then
Debug.Print strAnnDay
End If
End If
Next

Debug.Print "done."
End Sub
 
Hi,

I think this is what I'm looking for as when I enter a birthday into an
existing contact, a calendar entry doesn't appear, however if I make a new
contact from scratch with a birthday then save and close, then the calendar
entry for the birthday appears as expected.

If this code will resolve my issues, how do I implement it? Do I need to
use it in a custom form? any step by step instructions you can give or point
to?

Thanks in advance.
 
Well this code doesn't fix any problems whatsoever. It merely tells
you where the problems are, in the 'immediate' (aka Debug) window.
Once I had my list of problem entries, I went back to my original
contact. I then altered that date a wee bit, by adding a space! For
example, in 'Mon 3/8/2004' I would add another space after the Mon
but before the 3. Then hit save. Outlook will think it's a change
and will recreate the calender entry.

I put this code into an Outlook macro to run it. Like it said, it was
a quicky. Maybe I'll get around to adding a nice form, and add code
to correct the schedule. But for now at least you can tell what's
missing!
 
Thanks,
I didn't have that many birthdays so i just did it manually. Thanks for the
tip.
 
Back
Top