Application.Ontime 取消无法调用对象“Application”的“ONTIME”方法

I am 完全地失去了所以任何帮助将不胜感激。

我试图取消打开工作簿时触发的 2 个计划事件，并使用 Application.Ontime 方法重复。

我知道要终止 OnTime 计划循环，您必须提供计划运行的确切时间，并且拥有多个 Application.OnTime 任务需要多个变量。 这就是为什么我设置了两个公共变量（Option Explicit 下面的文档标题）：

Dim dTime as Date
Dim dTime2 as Date

调度程序使用这些变量，并且代码每分钟运行一次，一切正常。

dTime的值设置在任务追踪器函数为：

dTime = Now() + TimeValue("00:01:00")
Application.OnTime dTime, "TaskTracker", , True

dTime2的值设置在自动清除函数为：

dTime2 = Now() + TimeValue("00:01:00")
Application.OnTime dTime, "AutoClear", , True

尽管如此，我还是得到了对象“Application”的方法“ONTIME”尝试在模块末尾运行该函数时出现错误消息：

Function AutoDeactivate()
Application.OnTime EarliestTime:=dTime, Procedure:="TaskTracker", _
    Schedule:=False
Application.OnTime EarliestTime:=dTime2, Procedure:="AutoClear", _
    Schedule:=False
End Function

这是我绝对不明白出了什么问题的地方。触发调试会将我带到每个过程取消尝试的 OnTime 部分。

下面是包含这些元素的脚本。希望这能让你们了解为什么这些活动不能被取消。

Option Explicit
Dim dTime As Date
Dim dTime2 As Date

'------------------------------------------------------------
'This is what checks cells to define if an email notification has to be sent, and what the content of that email should be.
'------------------------------------------------------------
Function TaskTracker()
Dim FormulaCell     As Range
Dim FormulaRange    As Range
Dim NotSentMsg      As String
Dim MyMsg           As String
Dim SentMsg         As String
Dim SendTo          As String
Dim CCTo            As String
Dim BCCTo           As String
Dim MyLimit         As Double
Dim MyLimit2        As Double

dTime = Now() + TimeValue("00:01:00")
NotSentMsg = "Not Sent"
SentMsg = "Sent"
SendTo = ThisWorkbook.Worksheets("Tasks").Range("D2")
CCTo = ThisWorkbook.Worksheets("Tasks").Range("E2")
BCCTo = ThisWorkbook.Worksheets("Tasks").Range("F2")

MyLimit = Date
MyLimit2 = ((Round(Now * 1440, 0) - 30) / 1440)

Set FormulaRange = ThisWorkbook.Worksheets("Tasks").Range("F5:F35")
On Error GoTo EndMacro:
For Each FormulaCell In FormulaRange.Cells
    With FormulaCell
            If DateValue(CDate(.Value)) = MyLimit Then
                MyMsg = SentMsg
                If .Offset(0, 1).Value = NotSentMsg Then
                    strTO = SendTo
                    strCC = CCTo
                    strBCC = BCCTo
                    strSub = "[Task Manager] Reminder that you need to: " & Cells(FormulaCell.Row, "B").Value

                If Cells(FormulaCell.Row, "C").Value = "" Then
                        strBody = "Greetings, " & vbNewLine & vbNewLine & _
                        "Your task : " & Cells(FormulaCell.Row, "B").Value & " is nearing its Due Date: " & Cells(FormulaCell.Row, "F").Value & "." & vbNewLine & "A wise decision would be to complete this task before it expires!" & _
                        vbNewLine & vbNewLine & "Truly yours," & vbNewLine & "Task Manager"
                Else
                        strBody = "Hello, " & vbNewLine & vbNewLine & _
                        "Your task : " & Cells(FormulaCell.Row, "B").Value & " with the mention: " & Cells(FormulaCell.Row, "C").Value & " is nearing its Due Date: " & Cells(FormulaCell.Row, "F").Value & "." & vbNewLine & "A wise decision would be to complete this task before it expires!" & _
                        vbNewLine & vbNewLine & "Truly yours," & vbNewLine & "Task Manager"
                End If
        If sendMail(strTO, strSub, strBody, strCC) = True Then MyMsg = SentMsg
        End If

            Else
            MyMsg = NotSentMsg
            End If

            If .Value = MyLimit2 Then
            MyMsg = NotSentMsg
        End If

            Application.EnableEvents = False
            .Offset(0, 1).Value = MyMsg
            Application.EnableEvents = True

    End With

Next FormulaCell

ExitMacro:
Exit Function

EndMacro:
Application.EnableEvents = True

MsgBox "Some Error occurred." _
     & vbLf & Err.Number _
     & vbLf & Err.Description

Application.OnTime dTime, "TaskTracker", , True

End Function
'------------------------------------------------------------
'This is the function that clears the rows of Completed Tasks
'------------------------------------------------------------
Function AutoClear()
Dim i As Integer

dTime2 = Now() + TimeValue("00:01:00")

With Tasks
    For i = 5 To 35
         If .Cells(i, 4).Value Like "Done" And .Cells(i, 5).Value = "1" Then
            .Cells(i, 1).ClearContents
            .Cells(i, 2).ClearContents
            .Cells(i, 3).ClearContents
            .Cells(i, 5).ClearContents
            .Cells(i, 6).ClearContents
            .Cells(i, 4).Value = "Pending"
            .Cells(i, 7).Value = "Not Sent"

        End If
    Next i
End With

Tasks.AutoFilter.ApplyFilter
Application.OnTime dTime2, "AutoClear", , True

End Function
'------------------------------------------------------------
'ThisWorkbook calls this to deactivate the Application.OnTime. This "should" prevent the Excel process from reoppening the worksheets.
'------------------------------------------------------------

Function AutoDeactivate()
On Error Resume Next
Application.OnTime EarliestTime:=dTime, Procedure:="TaskTracker", _
    Schedule:=False
Application.OnTime EarliestTime:=dTime2, Procedure:="AutoClear", _
    Schedule:=False
End Function

看来是设置错误！

Option Explicit
Dim dTime As Date
Dim dTime2 As Date

Application.OnTime dTime, "TaskTracker", , True
Application.OnTime dTime2, "AutoClear", , True

工作簿关闭时调用的 AutoDeactivation 函数确实可以按预期工作！

Function AutoDeactivate()
On Error Resume Next
Application.OnTime EarliestTime:=dTime, Procedure:="TaskTracker", _
Schedule:=False
Application.OnTime EarliestTime:=dTime2, Procedure:="AutoClear", _
Schedule:=False
End Function

工作簿_关闭前：

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Call AutoDeactivate
End Sub

发生的事情非常愚蠢。我在取消工作时遇到了问题，因此我将 Excel 表带回家并编写了上面找到的修复程序。然而，它仍然没有起作用。不是因为其中有错误，而是因为我家里没有Outlook！ ：P

没有 Outlook 应用程序会阻止事件在运行一次后重新安排（导致自动消除 ActiveX 错误消息）。

因此，当我将此脚本重新投入使用（安装了 Outlook 的地方）时，一切都正常运行:)

将此标记为我自己解决的哈哈。