Wie kann ich in Excel VBA auf MEHRERE ausstehende application.ontime-Ereignisse prüfen oder diese abbrechen?

Question

Ich verwende das Ereignis Application.Ontime, um ein Zeitfeld aus einer Zelle zu ziehen und ein Unterprogramm für die Ausführung zu diesem Zeitpunkt zu planen. Mein Ereignis Application.Ontime läuft auf das Ereignis Workbook_BeforeSave. Wenn also ein Benutzer (ändert die gewünschte Zeit + speichert die Arbeitsmappe) mehrfach, werden mehrere Application.Ontime-Ereignisse erzeugt. Theoretisch könnte ich jedes Ereignis mit einer eindeutigen Zeitvariablen verfolgen aber gibt es eine Möglichkeit, ausstehende Ereignisse zu prüfen/zu analysieren/abzubrechen?

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

Wenn ich also:
B9 auf 12:01 ändern, die Arbeitsmappe speichern
ändern Sie B9 in 12:03, speichern Sie die Arbeitsmappe
B9 auf 12:05 ändern, die Arbeitsmappe speichern
B9 auf 12:07 ändern, die Arbeitsmappe speichern
usw.

Am Ende werden mehrere Ereignisse ausgelöst. Ich möchte nur EIN Ereignis auslösen (das zuletzt geplante)

Wie kann ich ALLE ausstehenden Ereignisse (oder zumindest aufzählen sie) auf das Workbook_BeforeClose-Ereignis abbrechen?

Answer 1

Ich glaube nicht, dass Sie alle ausstehenden Ereignisse durchgehen oder sie alle auf einmal abbrechen können. Ich würde vorschlagen, eine Modulebene oder einen globalen Booleschen Wert zu setzen, der angibt, ob das Ereignis ausgelöst werden soll oder nicht. So würden Sie am Ende mit etwas wie dieses:

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

'fire event here

End Sub

Editer :

Fügen Sie dies zum TOP des Blattmoduls hinzu, das den Bereich enthält, der den gewünschten Datums-/Zeitwert enthält:

' 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

Und das bei einem Standardmodul:

Sub SendEmail()

    'add your proc here

End Sub

Answer 2

Jedes Mal, wenn Sie Application.Ontime aufrufen, speichern Sie die Zeit, zu der das Ereignis ausgeführt werden soll (Sie können sie auf einem Blatt oder in einem modulabhängigen dynamischen Array speichern)

Jedes Mal, wenn Ihr Ereignis ausgelöst wird, entfernen Sie die entsprechende gespeicherte Zeit

Um alle ausstehenden Ereignisse abzubrechen, iterieren Sie durch die verbleibenden gespeicherten Zeiten und rufen Application.Ontime mit schedule = false auf

Answer 3

Ich glaube, ich habe eine Lösung, die funktioniert, basierend auf einigen der bereits gegebenen Ratschläge.

Kurz gesagt, wir erstellen ein globales Array und jedes Mal, wenn der Benutzer auf save wird die SendTime in das Array geschrieben. Dies dient dazu, den Überblick über alle geplanten Zeiten zu behalten.

Wenn die Arbeitsmappe geschlossen wird, durchlaufen wir das Array und löschen alle geplanten Zeiten.

Ich habe dies getestet und es schien mit Excel 2003 zu funktionieren. Lassen Sie mich wissen, wie Sie vorankommen.

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

Answer 4

Oder Sie können einfach eine Zelle erstellen (z. B. Abakus):

wenn ich application.ontime verwende:

if range("V1") < 1 then

    Application.OnTime dTime, "MyMacro"

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

 end if

wenn ich mit dem Zählen aufhören will...

   Application.OnTime dTime, "MyMacro", , False

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