Jump to content


Photo

Outlook MACROs: Contact Birthdays and Private Appointments (VBA Code)

- - - - -

  • Please log in to reply
3 replies to this topic

Poll: Did you find this information useful? (4 member(s) have cast votes)

Did you find this information useful?

  1. Yes (4 votes [100.00%])

    Percentage of vote: 100.00%

  2. No (0 votes [0.00%])

    Percentage of vote: 0.00%

  3. What the &$!@ are you writing about! (0 votes [0.00%])

    Percentage of vote: 0.00%

  4. I have problems implementing this (0 votes [0.00%])

    Percentage of vote: 0.00%

Vote Guests cannot vote

#1
madu

madu

    Hardcore

  • Members
  • PipPipPipPipPipPip
  • 2,096 posts
  • Location:Kiev UA
  • Devices:E100
You may find this useful if you:
- use Microsoft Outlook and synchronize your device with PC;
- birthdays in calendar have shifted in date, but birth date is OK in contact(s);
- use Microsoft Exchange, share your calendar and want birthdays to be set to Private;
- want to have birthday reminders other than at 23:45;

WARNING: Back up Outlook data file before using this solution. Use at your own risk.

Tested on MS Outlook 2007.

My solution is based on the solutions that can be found here:
http://www.outlookco.../remindbday.htm
http://the-trusted-a...m...C!513.entry
Thanks A LOT to the authors!

SOLUTION 1
You want Outlook to automatically set appointment to Private and reminder time to 22:00 when a new birthday event is added to calendar by Outlook.

DEFAULT BEHAVIOR:
- create contact or select existing contact
- go to details and set birth date
- save contact
* Appointment automatically created BUT not set to private and reminder time used as set in settings (Tools>Options>Default reminder) 15 minutes.

TARGET BEHAVIOUR:
- create contact or select existing contact
- go to details and set birth date
- save contact
* Appointment automatically created and set to PRIVATE with reminder 2 hours before birthday date (22:00).

Use code below as described here: http://www.outlookco.../remindbday.htm (my code is modified):

In Outlook, press Alt+F11 to open VBA window, then double-click "ThisOutlookSession" in the left pane and paste code. Then close VBA window. Done.

            .Sensitivity = olPrivate                            'THIS MAKES APPOINTMENT PRIVATE
.Save
End With
End If
End Sub _linenums:0'>Dim WithEvents mcolCalItems As ItemsPrivate Sub Application_MAPILogonComplete() Dim objNS As NameSpace Set objNS = Application.GetNamespace("MAPI") Set mcolCalItems = objNS.GetDefaultFolder(olFolderCalendar).Items Set objNS = NothingEnd SubPrivate Sub mcolCalItems_ItemAdd(ByVal Item As Object) If Item.Class = olAppointment And _ InStr(Item.Subject, "Birthday") > 0 Then With Item .ReminderSet = True .ReminderMinutesBeforeStart = 120 'REMINDER TIME BEFORE DATE in MINUTES 120min = 2 hours .Sensitivity = olPrivate 'THIS MAKES APPOINTMENT PRIVATE .Save End With End IfEnd Sub

SOLUTION 2
You want to batch re/create all (or selected) birthday items in Calendar based on info in Contacts.

Useful if you import contacts or have problems with birthdays (appear one day before) in calendar due to time zone change or DST.

Follow the link below for step by step solution, but use MY CODE:
http://the-trusted-a...p;wa=wsignin1.0

BEFORE RUNNING THE CODE: Create a subfolder in Outlook/Calendar folder and MOVE all recurring appointments (birthdays) to this new folder.
TIP: Use Tools > Organize > Using Views > Recurring appointments for easy filtering and multiple selection - Select desired contacts, press Alt+F8 run macro NewBirthdayReminder.

Sub NewBirthdayReminder()        Dim objApp As Outlook.Application    Dim objNS As NameSpace    Dim objSelection As Outlook.Selection    Dim objItem As ContactItem       Set objApp = CreateObject("Outlook.Application")    Set objNS = objApp.GetNamespace("MAPI")    Set objSelection = objApp.ActiveExplorer.Selection           MsgBox ("Converting " & objSelection.Count)       For Each objItem In objSelection               objItem.Birthday = objItem.Birthday            objItem.Save    Next       End Sub

SOLUTION 3

You want to batch process Appointments in Calendar to set REMINDER TIME or PRIVATE (sensitivity).

Useful if you use Microsoft Exchange and SHARE your calendar. You want your contacts' birthdays to be invisible to others.

Follow the link below for step by step solution, but use MY CODE:
http://the-trusted-a...p;wa=wsignin1.0

TIP: Use Tools > Organize > Using Views > Recurring appointments for easy filtering and multiple selection - Select desired contacts, press Alt+F8 run macro MarkAppointmentPrivate.


    
MsgBox ("Converting " & objSelection.Count)

For Each objItem In objSelection

With objItem
.ReminderSet = True
.Sensitivity = olPrivate 'THIS MAKES APPOINTMENT PRIVATE
.Save
End With

objItem.Save

Next

End Sub _linenums:0'>Sub MarkAppointmentPrivate() Dim objApp As Outlook.Application Dim objNS As NameSpace Dim objSelection As Outlook.Selection Dim objItem As AppointmentItem Set objApp = CreateObject("Outlook.Application") Set objNS = objApp.GetNamespace("MAPI") Set objSelection = objApp.ActiveExplorer.Selection 'Set mcolCalItems = objNS.GetDefaultFolder(olFolderCalendar).Items 'test MsgBox ("Converting " & objSelection.Count) For Each objItem In objSelection With objItem .ReminderSet = True .Sensitivity = olPrivate 'THIS MAKES APPOINTMENT PRIVATE .Save End With objItem.Save Next End Sub



SOLUTION 4

You want to batch process Appointments in Calendar to set REMINDER TIME.

Useful if you want NEW reminder time to be set to all birthdays at once. If you do not like to wake up at 23:45 to snooze the reminder.

Follow the link below for step by step solution, but use MY CODE:
http://the-trusted-a...p;wa=wsignin1.0

TIP: Use Tools > Organize > Using Views > Recurring appointments for easy filtering and multiple selection - Select desired contacts, press Alt+F8 run macro MarkAppointmentTime.


    
MsgBox ("Converting " & objSelection.Count)

For Each objItem In objSelection

With objItem
.ReminderSet = True
.ReminderMinutesBeforeStart = 120 'REMINDER TIME BEFORE DATE in MINUTES 120min = 2 hours
.Save
End With

objItem.Save

Next

End Sub _linenums:0'>Sub MakeAppointmentTime() Dim objApp As Outlook.Application Dim objNS As NameSpace Dim objSelection As Outlook.Selection Dim objItem As AppointmentItem Set objApp = CreateObject("Outlook.Application") Set objNS = objApp.GetNamespace("MAPI") Set objSelection = objApp.ActiveExplorer.Selection 'Set mcolCalItems = objNS.GetDefaultFolder(olFolderCalendar).Items 'test MsgBox ("Converting " & objSelection.Count) For Each objItem In objSelection With objItem .ReminderSet = True .ReminderMinutesBeforeStart = 120 'REMINDER TIME BEFORE DATE in MINUTES 120min = 2 hours .Save End With objItem.Save Next End Sub

Thanks again to the authors of the original code.

GOOD LUCK


PS: Sorry for limited walkthrough and guiding, I have very little time but really wanted to post this solution.

Edited by madu, 11 August 2008 - 03:30 PM.

  • 0
.:: PocketMVP Skins :: Marcelo :: WinMedia :: Marcelo2 :: DeepcleanSP ::.
.:: Tweaks :: EarSaver :: iZip :: VoiceRec :: ASXCoder ::.

#2
chucky.egg

chucky.egg

    Did I say that out loud?

  • MoDaCo Silver
  • PipPipPipPipPipPip
  • 4,724 posts
  • Location:Kent, England
  • Interests:Sleeping
  • Devices:Desire S
  • Twitter:@chucky_egg
Yeah, I like this stuff.

I keep meaning to "fix" the reminder time for birthdays to be something sensible - rather than midnight! I want to know a few days in advance, and at a reasonable time of day (just before lunch would be good so I can get a card/present)

Now you've reminded me I might just get around to doing it!

  • 0

#3
madu

madu

    Hardcore

  • Members
  • PipPipPipPipPipPip
  • 2,096 posts
  • Location:Kiev UA
  • Devices:E100
In case you work by hours, replace the following line with new:
.ReminderMinutesBeforeStart = 120
replace to:
.ReminderMinutesBeforeStart = 60*XX
where XX is number of hours.

so if you want reminder at 12:00 two days before it should be
.ReminderMinutesBeforeStart = 60*36

  • 0
.:: PocketMVP Skins :: Marcelo :: WinMedia :: Marcelo2 :: DeepcleanSP ::.
.:: Tweaks :: EarSaver :: iZip :: VoiceRec :: ASXCoder ::.

#4
Praha1

Praha1

    Newbie

  • Members
  • Pip
  • 1 posts

In case you work by hours, replace the following line with new:
.ReminderMinutesBeforeStart = 120
replace to:
.ReminderMinutesBeforeStart = 60*XX
where XX is number of hours.

so if you want reminder at 12:00 two days before it should be
.ReminderMinutesBeforeStart = 60*36




Would anyone have a script to change create birthdays from contacts but limit the recurrence to a specific number of time / number of annual events instead of having no end date?

Or just a script that can change recurring events with no end to to a specific number of time / number of events

  • 0




0 user(s) are reading this topic

0 members, 0 guests, 0 anonymous users