Application.Ontime 取消方法 'ONTIME' 失败 Object 'Application'
Application.Ontime Cancel Fails to Method 'ONTIME' of Object 'Application'
我完全迷路了所以任何帮助将不胜感激。
我正在尝试取消 2 个在工作簿打开时触发的计划事件，并使用 Application.Ontime 方法重复。
我知道要终止 OnTime 计划循环，您必须提供计划到 运行 的确切时间，并且有多个 Application.OnTime 任务需要多个变量。
这就是为什么我设置了两个 Public 变量（Options Explicit 下面文档的 Header）：
Dim dTime as Date
Dim dTime2 as Date
调度程序使用这些变量，一切正常，代码每分钟 运行s。
dTime 的值在 TaskTracker 函数中设置为：
dTime = Now() + TimeValue("00:01:00")
Application.OnTime dTime, "TaskTracker", , True
dTime2 的值在 Autoclear 函数中设置为：
dTime2 = Now() + TimeValue("00:01:00")
Application.OnTime dTime, "AutoClear", , True
尽管如此，我在尝试 运行 函数时收到 Object'Application' 的 Method '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
Workbook_BeforeClose:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Call AutoDeactivate
End Sub
发生的事情非常愚蠢。我在工作中取消活动时遇到问题，所以我把 Excel Sheet 带回家并对上面找到的修复程序进行了编码。然而，它仍然没有用。不是因为里面有误，而是因为我家里没有Outlook！ :P
没有 Outlook 应用程序阻止事件在 运行 之后重新安排一次（导致自动关闭 ActiveX 错误消息）。
因此，一旦我将此脚本恢复工作（安装 Outlook 的位置）并且一切正常:)
标记为我自己解决了哈哈
我完全迷路了所以任何帮助将不胜感激。
我正在尝试取消 2 个在工作簿打开时触发的计划事件，并使用 Application.Ontime 方法重复。
我知道要终止 OnTime 计划循环，您必须提供计划到 运行 的确切时间，并且有多个 Application.OnTime 任务需要多个变量。 这就是为什么我设置了两个 Public 变量（Options Explicit 下面文档的 Header）：
Dim dTime as Date
Dim dTime2 as Date
调度程序使用这些变量，一切正常，代码每分钟 运行s。
dTime 的值在 TaskTracker 函数中设置为：
dTime = Now() + TimeValue("00:01:00")
Application.OnTime dTime, "TaskTracker", , True
dTime2 的值在 Autoclear 函数中设置为：
dTime2 = Now() + TimeValue("00:01:00")
Application.OnTime dTime, "AutoClear", , True
尽管如此，我在尝试 运行 函数时收到 Object'Application' 的 Method '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
Workbook_BeforeClose:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Call AutoDeactivate
End Sub
发生的事情非常愚蠢。我在工作中取消活动时遇到问题，所以我把 Excel Sheet 带回家并对上面找到的修复程序进行了编码。然而，它仍然没有用。不是因为里面有误，而是因为我家里没有Outlook！ :P
没有 Outlook 应用程序阻止事件在 运行 之后重新安排一次（导致自动关闭 ActiveX 错误消息）。
因此，一旦我将此脚本恢复工作（安装 Outlook 的位置）并且一切正常:)
标记为我自己解决了哈哈