Solved: Use Timer in Outlook

[dicepackage]

I am trying to run a piece of code once every ten minutes in Outlook 2003. The rest of the program should still function during this time. I am not sure if Outlook has an On Timer event but I would like to implement something like that. Could someone point me in the right direction so that every ten minutes in Outlook I can get a message box?

[JP2112]

What I would do is set up a task reminder for 10 minutes out, then use the Application_Reminder event to wait for that reminder to fire and run your code. Schedule another reminder for 10 minutes later.

The whole thing should loop itself for as long as Outlook is open.

[dicepackage]

How do I get the reminder to fire and how do I get it to re-activate? I currently have the following code but it does nothing at the moment. Also keep in mind I want this to run my own custom code every ten minutes. I just used the MsgBox example because I didn't need all of my code in there complicating things.

Private Sub Application_Reminder(ByVal Item As Object)
    MsgBox ("Hello World")
End Sub

[JP2112]

Keep in mind you'll need to restart Outlook after adding or changing any event code.

You need to manually set up a task with a reminder time 10 minutes into the future. I suppose you could do it programmatically, perhaps when Outlook is started, but I assume you want more control.

If you want to test out the Reminder Event handler, just set up a dummy task with a reminder 1 minute from now. Just wait for the event to fire.

To set up the "live" code, take out the MsgBox part and substitute it with your custom code. Then, before the event handler ends, you need to create another task with a reminder 10 minutes into the future. You may also need to dismiss or "mark complete" the currently firing reminder.

[dicepackage]

I'm further but not quite where I would like to be. I have it now so that every ten minutes it will run this appointment and it will keep creating another appointment ten minutes into the future. I don't want a million appointments in my calendar so how would I go about deleting the old one before adding the new?

Also is there a way to not have a reminder come up for these appointments I am creating but to still have the code run?

Private WithEvents MyReminders As Outlook.Reminders

Private Sub Application_Reminder(ByVal Item As Object)
    MsgBox ("This is where I would place my custom code")
    Set apti = Application.CreateItem(olAppointmentItem)
    apti.Subject = "Trigger Appointment"
    apti.Start = DateAdd("n", 10, Now)
    apti.End = DateAdd("n", 1, apti.Start)
    apti.ReminderSet = True
    apti.ReminderMinutesBeforeStart = 5
    apti.Save
End Sub

[JP2112]

Although it really doesn't matter, I would use a task, not an appointment.

I may have given you the wrong event. Here's how I would do it.

Just run the StartRemindingMe procedure to begin the process.

Private WithEvents myReminders As Outlook.Reminders
Const taskSubject As String = "Trigger Task"
Const amountOfTime As Long = 10

Private Sub myReminders_BeforeReminderShow(Cancel As Boolean)
Dim remind As Outlook.Reminder
' check to make sure we're working on the correct reminder
Set remind = myReminders.Item(1)
If remind.Caption = taskSubject Then
    MsgBox ("This is where I would place my custom code")
End If
' cancel the reminder
Cancel = True
End Sub

Private Sub myReminders_ReminderFire(ByVal ReminderObject As Reminder)
Dim tsk As Outlook.TaskItem
' create task again
Set tsk = Application.CreateItem(olTaskItem)
With tsk
    .subject = taskSubject
    .StartDate = Format(Now, "mm/dd/yyyy")
    .ReminderSet = True
    .reminderTime = DateAdd("n", amountOfTime, Now)
    .Save
End With
End Sub

Public Sub StartRemindingMe()
Dim olApp As Outlook.Application
Dim olNS As Outlook.NameSpace
Dim tsk As Outlook.TaskItem
Dim tasksFolder As Outlook.MAPIFolder
Dim tasks As Outlook.Items
Dim matchingTasks As Outlook.Items
Dim i As Long
Dim task As Outlook.TaskItem
' only start watching reminders when I say so
Set olApp = Outlook.Application
Set myReminders = olApp.Reminders
' delete any existing tasks
Set olNS = olApp.GetNamespace("MAPI")
Set tasksFolder = olNS.GetDefaultFolder(olFolderTasks)
Set tasks = tasksFolder.Items
Set matchingTasks = tasks.Restrict("[Subject] = '" & taskSubject & "'")
For i = matchingTasks.Count To 1 Step -1
    Set task = matchingTasks.Item(i)
    If task.subject = taskSubject Then
        With task
            .MarkComplete
            .Delete
        End With
    End If
Next i
' create initial task
Set tsk = Application.CreateItem(olTaskItem)
With tsk
    .subject = taskSubject
    .StartDate = Format(Now, "mm/dd/yyyy")
    .ReminderSet = True
    .reminderTime = DateAdd("n", amountOfTime, Now)
    .Save
End With
End Sub

[dicepackage]

Thank you very much. I got it working with the help of your code. I found one bug in that when you have myReminders_ReminderFire execute it creates a second task so everything would run twice. I got rid of the function entirely and added an option for startup. Here is the code in its entirety in case anyone else is interested:

Private WithEvents myReminders As Outlook.Reminders
Const taskSubject As String = "Trigger Task"
Const amountOfTime As Long = 10

Private Sub Application_Reminder(ByVal Item As Object)
    StartRemindingMe
End Sub

Private Sub Application_Startup()
    StartRemindingMe
End Sub

Private Sub myReminders_BeforeReminderShow(Cancel As Boolean)
    Dim remind As Outlook.Reminder
     ' check to make sure we're working on the correct reminder
    Set remind = myReminders.Item(1)
    If remind.Caption = taskSubject Then
    MsgBox ("This is where I would place my custom code")
    End If
     ' cancel the reminder
    Cancel = True
End Sub

Public Sub StartRemindingMe()
    Dim olApp As Outlook.Application
    Dim olNS As Outlook.NameSpace
    Dim tsk As Outlook.TaskItem
    Dim tasksFolder As Outlook.MAPIFolder
    Dim tasks As Outlook.Items
    Dim matchingTasks As Outlook.Items
    Dim i As Long
    Dim task As Outlook.TaskItem
     ' only start watching reminders when I say so
    Set olApp = Outlook.Application
    Set myReminders = olApp.Reminders
     ' delete any existing tasks
    Set olNS = olApp.GetNamespace("MAPI")
    Set tasksFolder = olNS.GetDefaultFolder(olFolderTasks)
    Set tasks = tasksFolder.Items
    Set matchingTasks = tasks.Restrict("[Subject] = '" & taskSubject & "'")
    For i = matchingTasks.Count To 1 Step -1
    Set task = matchingTasks.Item(i)
    If task.Subject = taskSubject Then
        With task
            .MarkComplete
            .Delete
        End With
    End If
    Next i
     ' create initial task
    Set tsk = Application.CreateItem(olTaskItem)
    With tsk
    .Subject = taskSubject
    .StartDate = Format(Now, "mm/dd/yyyy")
    .ReminderSet = True
    .ReminderTime = DateAdd("n", amountOfTime, Now)
    .Save
    End With
End Sub

[JP2112]

Excellent!

[bxdobs]

Been searching for a Timer Event solution to use in Outlook 2003 to complete a workaround (zero-budget) project ... use of the W32 API mSec Sleep Function is one option but apparently comes with the potential to crash the OS and or slow down other apps

Was excited to find these examples of using Reminders to simulate a timer event, however, I must be missing some key concept(s) ... numerous attempts to get this code to run all fail to trigger an actual EVENT (tried all 3 Event possibilities; Reminder, Snooze, BeforeReminderShow) ... my results suggest that the "EVENT HANDLER" code is never called

Found this link that describes how to use WithEvents
https://bettersolutions.com/vba/even...dule-level.htm

Could someone Please confirm whether the following 5 details (based on the above link) are applicable to the examples in this thread?

1) WithEvents statements must be defined within the header of a CLASS MODULE

2) Event-related vars & code(functions|subs) appear to be defined within the same CLASS MODULE

3) Application_Start is suggested to be defined in ThisOutlookSession (appears to work from a Module as well)

4) Global Objects related to CLASS should be defined within a Module header

5) Application_Start needs to create a NEW instance of any CLASS Objects referencing their Global Objects
- this isn't clear from the link but my take is an EVENT HANDLER MUST BE AVAILABLE (PERSISTENT) to be run
(a global object is persistent)
- perhaps an EVENT HANDLER can still be defined as a non-class method in some Module

Update: the Event Handler BeforeReminderShow still not running:

' thisOutlookSession
Option Explicit
Sub Application_Startup() ' automatically run each time Outlook is started ... 
 Set oADI_TMR = New cmADI_TMR
 Dim tsk As Outlook.TaskItem
 ' create initial task
 Set tsk = Application.CreateItem(olTaskItem)
 tsk.Subject = "ADI_TMR" ' This item is showing up in the task list and when it times out it is popping up a Reminder Dialog
 tsk.StartDate = Format(Now, "mm/dd/yyyy")
 tsk.ReminderSet = True
 tsk.ReminderTime = DateAdd("n", 1, Now)
 tsk.Save
 Debug.Print Now; "AS "; tsk.ReminderTime
 
End Sub

Sub tstCode()
 Debug.Print Now; "some test code"
End Sub

This just contains the Global oADI_TMR object

' Module mdADI_TMR
Option Explicit
Public oADI_TMR As cmADI_TMR

The oADI_TMR object was created but the B4 event isn't run resulting in the popup showing up

' Class Module cmADI_TMR
Option Explicit
Public WithEvents myReminders As Outlook.reminders

Private Sub Class_Initialize()
  debug.print now ; "oADI_TMR has been created"
End Sub

' expected this sub to stop the Reminder popup plus it is supposed to snooze the reminder
Private Sub myReminders_BeforeReminderShow(Cancel As Boolean)
 Dim rmd As Outlook.Reminder
 Set rmd = myReminders.Item(1) ' This is an unattended process there should only ever be one reminder
 If rmd.Caption = "ADI_TMR" Then
  Debug.Print Now; " b4 … calling test code"
  rmd.Snooze (1)
  Call ThisOutlookSession.tstCode ' call the process we want to run every minute
  Debug.Print Now; " snz "; rmd.NextReminderDate
  Cancel = False ' shouldn't need to destroy scheduled reminder because it was snoozed
 End If
End Sub

[bxdobs]

Ok hopefully found the final issue(s) (typo's and missed creating a myReminder Object

' Class Module cmADI_TMR
Option Explicit
Public WithEvents myReminders As Outlook.Reminders

Private Sub Class_Initialize()
Debug.Print Now; "Init"
Set myReminders = Outlook.Reminders
End Sub

Private Sub myReminders_BeforeReminderShow(Cancel As Boolean)
If myReminders.Item(1).Caption = "ADI_TMR" Then
    Debug.Print Now; " b4 … calling exec code"
    Call ThisOutlookSession.tstCode
    myReminders.Item(1).Snooze (1)
    Debug.Print Now; " snz "; myReminders.Item(1).NextReminderDate
    Cancel = False ' default value
End If
End Sub

[bxdobs]

Final note: the SNOOZE approach was totally unstable (breakpoints were not working at all ... so I added a counter to the Test Code stub ... each time this B4Show sub was entered it would oscillate around 150 to 200 times through my test stub ... very bizarre almost like the process would keep reentering the stub until maybe a stack overflowed) ... regardless ... I have reverted to deleting the Reminder and then adding a new Reminder back within the B4Show sub ... also added in the actual Email processor ... all is functioning properly now.

Hope this additional detail is more informative for future searches

[Aussiebear]

Welcome to VBAX bxdobs. Glad you were able to achieve an outcome, but a quick question "Outlook 2003" seems old for software isn't it?

[bxdobs]

Being a fixed income Retiree, with 48 years of H/W & S/W design experience, I make all attempts to reuse and recycle before resorting to upgrades

For this specific project, as Office Pro 2k3 meets the minimum task requirements and is AVAILABLE, my wallet remains closed

From my perspective, as long as Hardware/Software fulfills the required functionality it doesn't age
only we do

[Aussiebear]

Point well made Sir.