THISOUTLOOKSESSION

Private WithEvents olRemind As Outlook.Reminders

Private Sub Application_Startup()
  CreateAppointment
End Sub

Private Sub Application_Reminder(ByVal Item As Object)
Set olRemind = Outlook.Reminders

If Item.MessageClass <> "IPM.Appointment" Then
  Exit Sub
End If

If Item.Categories <> "Run in 5" Then
  Exit Sub
End If

' Call macro

'Delete appt from calendar when finished
Item.Delete

' Create another appt to repeat the process
CreateAppointment

End Sub

' dismiss reminder
Private Sub olRemind_BeforeReminderShow(Cancel As Boolean)

    For Each objRem In olRemind
            If objRem.Caption = "This Appointment reminder fires in 5" Then
                If objRem.IsVisible Then
                    objRem.Dismiss
                    Cancel = True
                End If
                Exit For
            End If
        Next objRem
End Sub