How can I check for or cancel MULTIPLE pending application.ontime events in excel VBA?

I'm using the Application.Ontime event to pull a time field from a cell, and schedule a subroutine to run at that time. My Application.Ontime event runs on the Workbook_BeforeSave event. As such, if a user (changes the desired time + sa开发者_C百科ves the workbook) multiple times, multiple Application.Ontime events are created. Theoretically I could keep track of each event with a unique time variable.. but is there a way to check/parse/cancel pending events?

Private Sub Workbook_BeforeSave
    SendTime = Sheets("Email").Range("B9")
    Application.OnTime SendTime, "SendEmail"
End Sub

Private Sub Workbook_BeforeClose
    Application.OnTime SendTime, "SendEmail", , False
End Sub

So if I:

change B9 to 12:01, Save the workbook

change B9 to 12:03, Save the workbook

change B9 to 12:05, Save the workbook

change B9 to 12:07, Save the workbook

etc

I end up with multiple events firing. I only want ONE event to fire (the most recently scheduled one)

How can I cancel ALL pending events (or enumerate them at least) on the Workbook_BeforeClose event?

---

I don't think you can iterate through all pending events or cancel them all in one shabang. I'd suggest setting a module level or global boolean indicating whether or not to fire your event. So you'd end up with something like this:

Dim m_AllowSendMailEvent As Boolean
Sub SendMail()
If Not m_AllowSendMailEvent Then Exit Sub

'fire event here

End Sub

Edit:

Add this to the TOP of the sheet module which contains the range which contains the date/time value you're after:

' Most recently scheduled OnTime event. (Module level variable.)
Dim PendingEventDate As Date

' Indicates whether an event has been set. (Module level variable.)
Dim EventSet As Boolean

Private Sub Worksheet_Change(ByVal Target As Range)

Dim SendTimeRange As Range

' Change to your range.
Set SendTimeRange = Me.Range("B9")

' If the range that was changed is the same as that which holds
' your date/time field, schedule an OnTime event.
If Target = SendTimeRange Then

    ' If an event has previously been set AND that time has not yet been
    ' reached, cancel it. (OnTime will fail if the EarliestTime parameter has
    ' already elapsed.)
    If EventSet And Now > PendingEventDate Then

        ' Cancel the event.
        Application.OnTime PendingEventDate, "SendEmail", , False

    End If

    ' Store the new scheduled OnTime event.
    PendingEventDate = SendTimeRange.Value

    ' Set the new event.
    Application.OnTime PendingEventDate, "SendEmail"

    ' Indicate that an event has been set.
    EventSet = True

End If

End Sub

And this to a standard module:

Sub SendEmail()

    'add your proc here

End Sub

---

Each time you call Application.Ontime save the time the event is set to run (you could save it on a sheet or in a module scoped dynamic array)

Each time your event fires, remove the corresponding saved time

To cancel all pending event iterate through the remaining saved times calling Application.Ontime with schedule = false

---

I think I may have a solution that works, based on some of the advice already given.

In short, we create a global array and each time the user hits save the SendTime is written to the array. This serves to keep track of all our scheduled times.

When the workbook is closed, we loop through the array and delete all scheduled times.

I tested this and it seemed to work on Excel 2003. Let me know how you get on.

Dim scheduleArray() As String //Set as global array to hold times

Private Sub Workbook_BeforeSave
    SendTime = Sheets("Email").Range("B9")
    AddToScheduleArray SendTime
    Application.OnTime SendTime, "SendEmail"
End Sub

Private Sub Workbook_BeforeClose
    On Error Resume Next
    Dim iArr As Integer, startTime As String

    For iArr = 0 To UBound(scheduleArray) - 1 //Loop through array and delete any existing scheduled actions 
        startTime = scheduleArray(iArr)
        Application.OnTime TimeValue(startTime), "SendEmail", , False
    Next iArr
End Sub

Sub AddToScheduleArray(startTime As String)
    Dim arrLength As Integer

    If Len(Join(scheduleArray)) < 1 Then
        arrLength = 0
    Else
        arrLength = UBound(scheduleArray)
    End If

    ReDim Preserve scheduleArray(arrLength + 1) //Resize array
    scheduleArray(arrLength) = startTime //Add start time
End Sub

---

or you can just create some cell (like abacus), for example:

if I use application.ontime:

if range("V1") < 1 then

    Application.OnTime dTime, "MyMacro"

    range("V1")=range("V1") + 1

 end if

if I want to stop counting...

   Application.OnTime dTime, "MyMacro", , False

   range("V1")=range("V1") - 1