'ActiveAppointment.bas
'njms 29.06.2003
'Enables Outlook Calendar to be used as Command Scheduler

'add this code to Outlook VB Project\ThisOutlookSession
'create an Appointment with the Category "ActiveAppointment"
'Command runs when reminder fires - reminder must be set
'add the shell cmd as a single line in the body

'Functions:
'Application_Reminder
'ActiveAppointment
'WSHRun

Private Sub Application_Reminder(ByVal Item As Object)
'Reminder event
  If (TypeOf Item Is AppointmentItem) And _
     (Item.Categories = "ActiveAppointment") Then _
        Call ActiveAppointment(Item)
End Sub

Public Function ActiveAppointment(ByVal appt As AppointmentItem)
'handle ActiveAppointment
  Dim b As String
  b = appt.Body 'get cmd
  appt.ReminderSet = False
  appt.Close (False) 'close reminder popup
  Call WSHRun(Trim(b), 1, False) 'run cmd
End Function

Public Function WSHRun(strCmd As String, bVisible As Integer, bWait)
'Shell run
  Dim WSHShell
  Set WSHShell = CreateObject("wscript.Shell")
  WSHShell.Run strCmd, bVisible, bWait
  Set WSHShell = Nothing
End Function