Excel VBA Application.OnTime定时执行时MsgBox重复弹出问题排查

• 计划开发一款可在后台循环运行的程序，执行刷新查询类操作时不会造成Excel卡顿，程序运行异常时可弹出提示信息。

• 采用Application.OnTime方法调度过程，过程运行时自行指定下次执行时间，通过切换Excel工作表内的滑块控件即可停止过程运行。

每次过程触发时MsgBox都会连续弹出两次：

• 第一次弹窗显示的时间为当前时间Now
• 第二次弹窗紧随第一次弹出，显示的时间为Now+20秒

Public Sub sendingAmessage(schTime As Date)
   
If Worksheets("MAIN").Range("ToggleText").Value = "MONITORING ON" Then
    
    AppActivate Application.Caption
    MsgBox (schTime)
    
    Application.OnTime schTime, "'sendingAmessage""" & DateAdd("s", 20, Now) & "'"
End If

End Sub

连续弹窗是Application.OnTime参数书写错误导致的即时重复触发，和描述的现象完全对应：

1. Application.OnTime的基础语法是Application.OnTime(触发时间, 要执行的过程名)，代码里把本次传入的schTime（也就是本次过程启动的当前时间）填到了「触发时间」参数位，执行到这行时相当于告诉Excel“现在立刻再跑一次这个过程”，根本没有等待20秒的间隔。
2. 拼接的过程参数字符串里，把20秒后的时间作为参数传给了这次立刻触发的新过程，所以第一次弹窗显示的是本次传入的当前时间，紧接着触发的第二次弹窗显示的就是计算出来的Now+20秒的时间，和遇到的现象完全吻合。
3. 现有停止逻辑只加了过程内的判断，没有取消已经排好期的定时任务，后续哪怕滑块切到停止状态，已经注册的定时任务还是会触发运行。

Public Sub sendingAmessage(schTime As Date)
    If Worksheets("MAIN").Range("ToggleText").Value = "MONITORING ON" Then
        AppActivate Application.Caption
        MsgBox schTime
        ' 提前定义下次运行时间，统一给触发参数和过程传参使用
        Dim nextRunTime As Date
        nextRunTime = DateAdd("s", 20, Now)
        ' 修正参数顺序：第一个位置传下次触发时间，第二个位置正确拼接带参数的过程名
        Application.OnTime nextRunTime, "'sendingAmessage """ & nextRunTime & """'"
    End If
End Sub

补充提示：滑块切到停止状态的逻辑里，需要加Application.OnTime 已记录的下次运行时间, "'sendingAmessage """ & 已记录的下次运行时间 & """'", Schedule:=False来注销已经排期的任务，避免停止后过程还被触发。

内容的提问来源于stack exchange，提问作者N3VTr0N