All geek questions in one place

Application.OnTime failed

I am trying to cancel a timer in a Workbook_Close procedure in a ThisWorkbook module. Can someone explain the following behavior ?:

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 nonexistent timer, I get an error

ERROR: 1004: Failed to execute OnTime method of _ _Application object

For me, this indicates that the function is working correctly.

Closing a book using ThisWorkbook.Close The timer is not killed, as evidenced by the facts that:

  • The workbook opens again 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 when trying to kill a nonexistent timer

Further context

Application.Run fires as expected in both cases. For me, this indicates that the application object is still loaded, and the VBA runtime is working fine.

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 this book

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 are 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

Trail to close with. Close by running closeWorkbook (should have reset 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
+2
source share
1 answer

I made some changes. For testing purposes, we only need msgbox to find out if the procedure started / stopped correctly.

In the 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 the ThisWorkbook module:

Option Explicit

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Run "CloseWB"
End Sub

Private Sub Workbook_Open()
    Run "TimerStart"
End Sub

. :

  • "TimerSet" > msgbox > "TimerKill" .
  • "TimerSet" > msgbox > .
  • > msgbox > .
  • > msgbox > , CloseWB.

:

  • "TimerKill" Workbook_BeforeClose . .
  • "CloseWB" Workbook_BeforeClose .

, . .

0

Source: https://habr.com/ru/post/1625208/

More articles:


All Articles