How to automaticaly dismiss overdue reminder

Private Sub Application_Startup()
    KillOverdueReminders
End Sub

Sub KillOverdueReminders()
    ' Purpose: Kills all reminders for past due appointments.'
    ' Usage:   Run at Outlook startup to eliminate reminders on appointments that occur in the past.'
    ' Written: 4/1/2011'
    ' Author:  David Lee'
    ' Outlook: All versions'
    Const GRACE_PERIOD_MINUTES = 60
    Dim olkReminder As Outlook.Reminder, intIndex As Integer
    For intIndex = Application.Reminders.count To 1 Step -1
        Set olkReminder = Outlook.Reminders.Item(intIndex)
        If olkReminder.Item.Class = olAppointment Then
            If DateAdd("n", GRACE_PERIOD_MINUTES * -1, Now) > olkReminder.NextReminderDate Then
                olkReminder.Dismiss
            End If
        End If
    Next
    Set olkReminder = Nothing
End Sub

Select all Open in new window