RSS
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
with:
Set Items = Ns.GetDefaultFolder(olFolderCalendar).Folders("SharedCal").ItemsWhen 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").ItemsTo 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").ItemsThen get the function from Working with VBA and non-default Outlook Folders
More Information
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.
