0
votes

I am completely lost so any help will be greatly appreciated.

I am attempting to cancel 2 scheduled event that are triggered when the Workbook is opened, and repeated using the Application.Ontime method.

I know that to terminate the OnTime schedule loop, you must provide the exact time that it is scheduled to run and that having multiple Application.OnTime tasks requires multiple variables. This is why I have set two Public variables (Header of the document below Options Explicit):

Dim dTime as Date
Dim dTime2 as Date

The scheduler use these Variables and everything works properly as the code runs every minute.

dTime's value is set inside the TaskTracker function to be:

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

dTime2's value is set inside the Autoclear function to be:

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

Despite all this, I get a Method 'ONTIME' of Object'Application' error message when attempting to run the function at the end of the module:

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

This is where I absolutely do not get what is going wrong. Triggering the Debug brings me to the OnTime section of each procedure cancel attempt.

Below is the script that contains these elements. Hopefully this will give you guys some insight as to why these event can't be canceled.

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
1
I only see an error when trying to clear a non-set timeout. Are you certain the timeouts are actually set when you're trying to clear them? Eg "TaskTracker" only gets set if there's an error in the Function. - Tim Williams
Hey @TimWilliams thanks for the reply. The timers are indeed set when I attempt to clear them. Both functions are called when the Workbook is opened, and the AutoDeactivate function is called when the Workbook is closed. I know that they are sceduled even when I get the error message as the Workbook re-open itself after closure (which is the problem I attempt to fix by canceling the schedule). Since the workbook reopen, there must have been an event scheduled. - Francis Maltais

1 Answers

1
votes

It looks like it was a setup mistake!

Option Explicit
Dim dTime As Date
Dim dTime2 As Date

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

With the AutoDeactivation function called when the workbook closes does work as intended!

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

What was happening is pretty idiotic. I had an issue with canceling the event at Work, so I took the Excel Sheet home and coded the fix found above. Yet, it still didn't work. Not because there was a mistake in it, but because I didn't have Outlook at home! :P

Not having the Outlook application prevented the event from being rescheduled after running once (resulting in an auto-dismissed ActiveX error message).

So as soon as I took this script back to work (where Outlook is installed) and everything worked properly :)

Marking this as resolved by myself haha.