Private WithEvents MyReminders As Outlook.Reminders
Private Sub Application_Startup()
Set MyReminders = GetOutlookApp.Reminders
End Sub
Function GetOutlookApp() As Outlook.Application
Set GetOutlookApp = Outlook.Application
End Function
Private Sub MyReminders_ReminderFire(ByVal ReminderObject As Reminder)
If ReminderObject.Item.BusyStatus = 3 Then ' out of office
' set out of office
End If
End Sub