问题
I am trying to cancel a timer in the Workbook_Close routine in the ThisWorkbook module. Can anyone explain the following behaviour?:
Closing the workbook manually Application.OnTime functions as expected and cancels the timer. If I try to kill the same timer more than once, or a non-existent timer, I get an error
ERROR: 1004: Method 'OnTime' of object '_Application' failed
To me, this is supporting evidence that the function is working properly.
Closing the Workbook using ThisWorkbook.Close The timer is not killed as evidenced by the facts that:
- The workbook re-opens when the timer expires
- VBA does not throw any error if the same timer is killed more than once
- VBA does not throw an error on attempting to kill a non-existent timer
Further Context
Application.Run fires as expected in both cases. To me this indicates that the Application Object is still loaded and the VBA Runtime is still functioning properly.
Test Code
In a standard Module called minUnit
Private Sub testCallBack(name As String, nextTime As String)
MsgBox "callback " & name & " " & nextTime
End Sub
Public Function sProcedure(callBackProcedure As String, mName As String, nextTime As Date) As String
' Constructs a properly formatted string to feed to OnTime for a call back with two parameters
sProcedure = "'" & callBackProcedure & " " & """" & mName & """," & """" & fmtTime(nextTime) & """'"
End Function
Private Sub testTimerSet()
gnextTime = Now() + TimeSerial(1, 0, 0)
Application.OnTime gnextTime, sProcedure("Globals.testCallBack", _
"testTimer", gnextTime)
End Sub
Public Sub testTimerKill()
On Error Resume Next
Application.OnTime gnextTime, sProcedure("Globals.testCallBack", _
"testTimer", gnextTime), _
, False
End Sub
In ThisWorkbook
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Globals.testTimerKill
Globals.testTimerKill
Globals.testTimerKill
On Error Resume Next
Application.OnTime 0, "Nothing", , False
Application.Run sProcedure("minUnit.testCallBack", "Application.Run", Now())
Application.OnTime Now(), sProcedure("minUnit.testCallBack", "Application.OnTime Now()", Now()), , True
End Sub
Sub closeWorkbook()
ThisWorkbook.Close
End Sub
Trace for manual closing (errors thrown as expected)...
20:27:07:206 minUnit.testTimerSet: START 20:27:07:209 Application.OnTime 'minUnit.testCallBack "testTimer","21:27:07"' :0.003532 20:27:07:212 minUnit.testTimerSet: END :0.006447 20:27:13:618 minUnit.testTimerKill: START 20:27:13:621 minUnit.testTimerKill: END :0.003337 20:27:21:240 minUnit.testTimerSet: START 20:27:21:244 Application.OnTime 'minUnit.testCallBack "testTimer","21:27:21"' :0.004301 20:27:21:246 minUnit.testTimerSet: END :0.006274 20:27:33:946 ThisWorkbook.Workbook_BeforeClose: START 20:27:33:949 minUnit.testTimerKill: START 20:27:33:951 minUnit.testTimerKill: END :0.001921 20:27:33:953 minUnit.testTimerKill: START 20:27:33:957 minUnit.testTimerKill: END 20:27:33:957**ERROR: 1004: Method 'OnTime' of object '_Application' failed :0.002433 20:27:33:963 minUnit.testTimerKill: START 20:27:33:967 minUnit.testTimerKill: END 20:27:33:967**ERROR: 1004: Method 'OnTime' of object '_Application' failed :0.002230 20:27:33:972 Application.OnTime 0, "Nothing", , False 20:27:33:972**ERROR: 1004: Method 'OnTime' of object '_Application' failed :0.024134 20:27:33:977 Application.Run 'minUnit.testCallBack "Application.Run","20:27:33"' :0.031184 20:27:33:983 minUnit.testCallBack: START 20:27:35:995 minUnit.testCallBack: END :2.012402 20:27:35:997 Application.OnTime Now() 'minUnit.testCallBack "Application.OnTime Now()","20:27:35"':2.051651 20:27:35:999 ThisWorkbook.Workbook_BeforeClose: END :2.053604
Trace for closing with .Close by running closeWorkbook (should have thrown the first error at 20:30:11:979)...
20:29:48:201 minUnit.testTimerSet: START 20:29:48:204 Application.OnTime 'minUnit.testCallBack "testTimer","21:29:48"' :0.003342 20:29:48:206 minUnit.testTimerSet: END :0.005207 20:29:51:942 minUnit.testTimerKill: START 20:29:51:945 minUnit.testTimerKill: END :0.002946 20:29:55:444 minUnit.testTimerSet: START 20:29:55:448 Application.OnTime 'minUnit.testCallBack "testTimer","21:29:55"' :0.003535 20:29:55:450 minUnit.testTimerSet: END :0.005446 20:30:11:966 ThisWorkbook.closeWorkbook: START 20:30:11:971 ThisWorkbook.Workbook_BeforeClose: START 20:30:11:973 minUnit.testTimerKill: START 20:30:11:975 minUnit.testTimerKill: END :0.001994 20:30:11:979 minUnit.testTimerKill: START 20:30:11:981 minUnit.testTimerKill: END :0.001847 20:30:11:983 minUnit.testTimerKill: START 20:30:11:986 minUnit.testTimerKill: END :0.002271 20:30:11:988 Application.OnTime 0, "Nothing", , False :0.016905 20:30:11:991 Application.Run 'minUnit.testCallBack "Application.Run","20:30:11"' :0.019140 20:30:11:996 minUnit.testCallBack: START 20:30:13:976 minUnit.testCallBack: END :1.979131 20:30:13:977 Application.OnTime Now() 'minUnit.testCallBack "Application.OnTime Now()","20:30:13"':2.005963 20:30:13:985 ThisWorkbook.Workbook_BeforeClose: END :2.013265
回答1:
I have made some modifications. For testing purposes we only need a msgbox to notice whether the routine has been run/stopped correctly.
In standard module:
Option Explicit
Public dTime As Date ' Needs to be a public/global variable
Public Sub TimerStart()
dTime = Now() + TimeSerial(0, 0, 5)
Application.OnTime dTime, "TimerStart"
MsgBox "Callback " & TimeValue(dTime)
End Sub
Public Sub TimerKill()
On Error Resume Next
Application.OnTime dTime, "TimerStart", , False
End Sub
Public Sub CloseWB()
TimerKill
ThisWorkbook.Close SaveChanges:=True
End Sub
In ThisWorkbook module:
Option Explicit
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Run "CloseWB"
End Sub
Private Sub Workbook_Open()
Run "TimerStart"
End Sub
This works for me. Following scenarios have been tested:
- Run "TimerSet" manually > Wait for a few msgboxes > Run "TimerKill" manually.
- Run "TimerSet" manually > Wait for a few msgboxes > Close workbook.
- Open workbook > Wait for a few msgboxes > Close workbook.
- Open workbook > Wait for a few msgboxes > Close workbook using the CloseWB macro.
What I've found is:
- Running "TimerKill" from Workbook_BeforeClose does not work. The workbook reopens.
- Running "CloseWB" from Workbook_BeforeClose works.
I'm sorry I can't explain why this is. However, it should work for you now.
来源：https://stackoverflow.com/questions/26649610/application-ontime-not-executed