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

Send us News! | Rules

Please Log In or Register - it's FREE!

You Are Here » WinMo @ MoDaCo » Smartphone / Windows Mobile Standard (non Touchscreen) » Smartphone General Discussion

Outlook MACROs: Contact Birthdays and Private Appointments (VBA Code), Recreate birthdays based on info in contacts or set all appointments t

Options

Did you find this information useful?

Yes	[ 2 ]	[100.00%]
No	[ 0 ]	[0.00%]
What the &$!@ are you writing about!	[ 0 ]	[0.00%]
I have problems implementing this	[ 0 ]	[0.00%]

Total Votes: 2

Guests cannot vote

madu

Aug 11 2008, 14:15

Post #1

Hardcore

Group: Posters
Posts: 2,098
Joined: 4th December 2002
From: Kiev UA
Member No.: 702

Device(s): 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.outlookcode.com/d/code/remindbday.htm
http://the-trusted-adviser.spaces.live.com...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.outlookcode.com/d/code/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.

CODE

Dim WithEvents mcolCalItems As Items

Private Sub Application_MAPILogonComplete()
    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)

    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 If
End 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-adviser.spaces.live.com...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.

CODE

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-adviser.spaces.live.com...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.

CODE

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-adviser.spaces.live.com...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.

CODE

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.

This post has been edited by madu: Aug 11 2008, 15:30

--------------------

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

chucky.egg

Aug 11 2008, 14:30

Post #2

Did I say that out loud?
Group Icon

Group: News Team
Posts: 4,530
Joined: 20th August 2003
From: Kent, England
Member No.: 13,469

Device(s): Kaiser, Touch

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!

madu

Aug 11 2008, 14:41

Post #3

Hardcore

Group: Posters
Posts: 2,098
Joined: 4th December 2002
From: Kiev UA
Member No.: 702

Device(s): 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

--------------------

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

« Next Oldest · Smartphone General Discussion · Next Newest »

Topic	Replies	Topic Starter	Views	Last Action
Disabling Samsung dialer and contacts	1	kordi	422	Yesterday, 21:24 Last post by: spy1983
Problems with Manilla 2D M2D01 and M2D03	12	johrub	924	Yesterday, 20:52 Last post by: saznpins
Uninstall NETCF2.0 and Install NETCF3.5	4	herojas	166	Today, 07:04 Last post by: herojas
Problem with Outlook after WM6.1 upgrade	0	SeanH	19	Yesterday, 23:01 Last post by: SeanH
www.icellparts.com sell:HTC XV6800 Lcd,Housing,keypad and antenna Sell 8130 Housing	0	icellparts	0	Today, 07:14 Last post by: icellparts
Web browsing, (legal) mp3 downloads and compressed file exrtraction Ability to dl .zip files to Omnia and extract without laptop?	0	ebyss	0	Today, 08:21 Last post by: ebyss