Dismiss annoying Outlook 2013 due reminders, but still buggy, who can improve it? Thanks!

outlook_2013_dismiss_due_reminders.vbs

' Declare this Wbject withEvents displaying all the events
Private WithEvents olRemind As Outlook.Reminders

Private Sub Application_Startup()
    ' Set olRemind = Outlook.Reminders
    ' KillOverdueReminders
End Sub

Private Sub KillOverdueReminders(Cancel As Boolean)
    ' 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'
    ' Modified: 11/30/2011'
    ' Author:  David Lee'
    ' Outlook: All versions'
    Const GRACE_PERIOD_MINUTES = 5

    Dim olkReminders As Outlook.Reminders, olkReminder As Outlook.Reminder, intCount As Integer, intIndex As Integer

    Set olkReminders = olRemind
    intCount = olkReminders.Count
    Cancel = False
    
    For intIndex = intCount To 1 Step -1
        Set olkReminder = olkReminders.Item(intIndex)
        If olkReminder.Item.Class = olAppointment Then
            If DateAdd("n", GRACE_PERIOD_MINUTES * -1, Now) > olkReminder.NextReminderDate Then
                olkReminders.Remove intIndex
                Cancel = True
            End If
        End If
    Next
    
    Set olkReminder = Nothing
End Sub

Private Sub Application_Reminder(ByVal Item As Object)
    Set olRemind = Outlook.Reminders
    ' RUN OTHER MACRO HERE
End Sub

Private Sub olRemind_BeforeReminderShow(Cancel As Boolean)
    KillOverdueReminders (Cancel)
End Sub