How to Remove Reminders on All Day Events

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").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