Another day, another macro in my "The Lazy Programmer Series", where I take existing code samples and tweak them to do other, similar things.
This code base, like many others I use, comes from Michael Bauer's VBOffice site and began life as Calendar: Delete the reminder of a meeting request.
This macro runs when Outlook starts and watches for new appointment items to be saved. When it finds one, it checks to see if it's an All Day Event, and if so, you are asked if you want to keep the reminder. While the tweaks here work with reminders, it can be tweaked to do almost anything when a new appointment or event is saved.
Remove Reminders on All Day Events
Open the VB Editor by pressing Alt+F11. Expand the Project to display ThisOutlookSession and paste the following code into the editor. Click in the Application_Startup sub and click the Run button on the toolbar. Repeat this step after making modifications to the code.
To test this macro without closing and restarting Outlook, you need to "run" the Application_Startup sub
Private WithEvents Items As Outlook.Items Private Sub Application_Startup() Dim Ns As Outlook.NameSpace Set Ns = Application.GetNamespace("MAPI") Set Items = Ns.GetDefaultFolder(olFolderCalendar).Items End Sub Private Sub Items_ItemAdd(ByVal Item As Object) On Error Resume Next Dim Appt As Outlook.AppointmentItem If TypeOf Item Is Outlook.AppointmentItem Then Set Appt = Item 'Checks to see if all day and if it has a reminder set to true If Appt.AllDayEvent = True And Appt.ReminderSet = True Then 'msgbox block - 3 lines If MsgBox("Do you want to remove the reminder?", vbYesNo) = vbNo Then Exit Sub End If 'appt.reminderset block - 2 lines Appt.ReminderSet = False Appt.Save End If End If End Sub
Customize the Code
This code sample has a lot of potential - you can use it to change almost any field in appointments and events (timed appointments or all day events). It applies to all new appointment items, including those created by Outlook when you enter a contact's birthday. To get you started, I've included some ideas below.
Keep all except 18 hour reminders
Would you prefer removing all 18 hour reminders but want to keep reminders if you select a different reminder time? Remove the If Msgbox... End If block and replace the Appt.Reminderset block with the following code.
If Appt.ReminderMinutesBeforeStart = 1080 Then Appt.ReminderSet = False Appt.Save End If
Set a different "default" reminder
To change the default reminder from 18 hours to another value, remove the If Msgbox... End If block and replace the Appt.Reminderset block with the following lines. This sample sets the reminder to 6 hours before the start, or 6PM.
If Appt.ReminderMinutesBeforeStart = 1080 Then Appt.ReminderMinutesBeforeStart = 360 Appt.Save
Keep reminders based on subject
To leave the reminder for appointments beginning with a specific keyword or character, replace the If Msgbox... End If code with the following code. This sample checks the first character for a ! and if found, the reminder is left on. You can check more characters by changing the number and phrase in Left(Appt.Subject, 1) = "!".
For example, an all day event with the subject !Training Classes would keep the 18 hour reminder, while Working downtown would not have a reminder.
If Left(Appt.Subject, 1) = "!" Then Exit Sub End If
Set longer reminders for birthdays
To set a reminder more than 18 hours before for Birthdays, remove the msgbox block and replace the appt.reminderset code with the following. This will set a reminder for 7.5 days on all birthdays, including those created when you add new contacts to Outlook and enter a birth date. We're also adding the Birthday category.
If Right(Appt.Subject, 8) = "Birthday" Then Appt.ReminderMinutesBeforeStart = 10800 Appt.Categories = "Birthday" Appt.Save
Set longer reminders for the first appointment after lunch
To set longer reminders for appointments that occur at certain times of the day, you need to check the start time. When only the time is entered, it applies to that time, any date.
' Checks the start time If Appt.Start = "#1:00:00 PM#" Then ' appt.reminderset block - 2 lines With Appt .ReminderSet = True .ReminderMinutesBeforeStart = 75 .Save End With End If
Use other calendar folders
If you want to use the macro on other calendar folders, you have two options: apply the macro to all Calendar folders or only to a specific folder.
To remove reminders from all day events in folders that are not the default calendar folder, you need to change the Application_Startup code to look in a different calendar folder.
If the folder is is a subfolder under the default Calendar folder (#1 in screenshot), replace
Set Items = Ns.GetDefaultFolder(olFolderCalendar).Items
Set Items = Ns.GetDefaultFolder(olFolderCalendar).Folders("SharedCal").Items
When the folder in your default data file or mailbox at the same level as the Calendar (and Inbox folder) (#2 in screenshot) use:
Set Items = Ns.GetDefaultFolder(olFolderCalendar).Parent.Folders("SharedCal").Items
To run the macro on all Calendar folders, use
Set Items = Application.ActiveExplorer.CurrentFolder.Items
If the folder is in another mailbox or data file, you need to use a function to find the folder path and call the function in the Startup procedure.
To use a Calendar folder called "Test Cal" in a pst file named "New PST", replace Set Items = Ns.GetDefaultFolder(olFolderCalendar).Items with:
Set Items = GetFolders("New PST\Test Cal").Items
Then get the function from Working with VBA and non-default Outlook Folders
Calendar: Delete the reminder of a meeting request This removes reminders from incoming meeting requests. I used it as the base for this macro.
Solution to disturbing default reminder for Outlook all-day events This code sample checks the reminder hour and if its set to remind you before or after a specific time period (such as before 8 am or after 9 pm) it recommends a new reminder time.
More Lazy Programmer code:
Bulk Change Contacts code is easily tweaked to change any field in a contact.