Want to protect your cyber security and still get fast solutions? Ask a secure question today.Go Premium

x
?
Solved

Cancelling a scheduled event

Posted on 2011-05-02
5
Medium Priority
?
158 Views
Last Modified: 2012-06-27
I want to close a workbook X minutes after the sheet was selected or printed or selection changed on the sheet.

Below is my code to achieve this.
I use a custom property to keep track of the last programed event & try to cancel it then program another event "to reset it".

It appears that the cancel sub appears not to work so its closing on an earlier close event.
So the book closes before it is supposed to when it is being used not after the period of inactivity as intended.

Option Explicit


Public Const NUM_MINUTES = 90

Public Sub TimedClose_Reset()
TimedClose_Cancel
TimedClose_Schedule
End Sub

Public Sub TimedClose_Cancel()
With ThisWorkbook.CustomDocumentProperties("Time_ClosePackage")
    On Error Resume Next 'Cancel the Close Event if it exists
    Application.OnTime _
        EarliestTime:=.Value, _
        procedure:="Close_NoSave_Timer", _
        Schedule:=False
End With
'If Range("SalesPersonCurrentName").Value = "Tom Moore" Or Range("SalesPersonCurrentName").Value = "Clinton Reid" Then MsgBox "Timer Cancelled"
End Sub

Public Sub TimedClose_Schedule()
With ThisWorkbook.CustomDocumentProperties("Time_ClosePackage")
    On Error GoTo 0 'Schedule another Close Event
    .Value = Now + TimeSerial(0, NUM_MINUTES, 0)
    Application.OnTime _
        EarliestTime:=.Value, _
        procedure:="Close_NoSave_Timer", _
        Schedule:=True
End With
End Sub


Sub Close_NoSave_Timer()
    Const sNameProc = "Close_NoSave_Timer" 'Specify the Function Name

    ThisWorkbook.Close SaveChanges:=False
    ThisWorkBook_ClosedByCode = True
    Application.Quit
End Sub


Private Sub Workbook_Open()
    MsgBox "This quote package will auto-close after " & NUM_MINUTES & " minutes of inactivity (or " & NUM_MINUTES / 60 & " Hours)"
    TimedClose_Schedule
End Sub



Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
On Error Resume Next
    TimedClose_Reset
On Error GoTo 0
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, _
ByVal Target As Range)
On Error Resume Next
If Not IS_Admin Then
    TimedClose_Reset
End If
On Error GoTo 0
End Sub


Private Sub Workbook_BeforePrint(Cancel As Boolean)
On Error Resume Next
    TimedClose_Reset
On Error GoTo 0
End Sub


Private Sub Workbook_BeforeClose(Cancel As Boolean)
On Error Resume Next
    TimedClose_Cancel()
On Error GoTo 0
End Sub



Public Sub CreateACustomProperty()
Dim WB As Workbook
Dim bLinkToContent As Boolean
Dim lType As Long
Dim vValue As Variant
Dim p As Variant
Dim cCPNameToDelete As String

Const cCPName = "Time_ClosePackage"
bLinkToContent = False
lType = msoPropertyTypeDate
vValue = Now

cCPNameToDelete = cCPName 'Uncomment unless adding a new name

Set WB = ThisWorkbook

With WB.CustomDocumentProperties
(cCPNameToDelete).DELETE ''Uncomment this line if  if want to delete a differen to one from creating
For Each p In .Parent.CustomDocumentProperties
    If p.name = cCPName Then p.DELETE
Next p

    .Add name:=cCPName, _
        LinkToContent:=bLinkToContent, _
        Type:=lType, _
        Value:=False
End With

End Sub

Open in new window

0
Comment
Question by:sir plus
  • 3
  • 2
5 Comments
 
LVL 81

Accepted Solution

by:
zorvek (Kevin Jones) earned 2000 total points
ID: 35509730
Cleaned up. This should work. You don't need the custom property.

Option Explicit

Private Const NUM_MINUTES = 90
Private Const NameProc = "Close_NoSave_Timer"
Private TimeToClose As Date

Public Sub TimedClose_Reset()

    TimedClose_Cancel
    TimedClose_Schedule
   
End Sub

Public Sub TimedClose_Cancel()

    On Error Resume Next
    Application.OnTime TimeToClose, NameProc, Schedule:=False
    On Error GoTo 0
    TimeToClose = 0

    'If Range("SalesPersonCurrentName").Value = "Tom Moore" Or Range("SalesPersonCurrentName").Value = "Clinton Reid" Then MsgBox "Timer Cancelled"

End Sub

Public Sub TimedClose_Schedule()

    TimeToClose = Now + TimeSerial(0, NUM_MINUTES, 0)
    Application.OnTime EarliestTime:=TimeToClose, procedure:=NameProc, Schedule:=True

End Sub

Sub Close_NoSave_Timer()

    ThisWorkbook.Close SaveChanges:=False
    ThisWorkBook_ClosedByCode = True
    Application.Quit
   
End Sub

Private Sub Workbook_Open()

    MsgBox "This quote package will auto-close after " & NUM_MINUTES & " minutes of inactivity (or " & NUM_MINUTES / 60 & " Hours)"
    TimedClose_Schedule
   
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

    TimedClose_Reset
   
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)

    If Not IS_Admin Then TimedClose_Reset

End Sub

Private Sub Workbook_BeforePrint(Cancel As Boolean)

    TimedClose_Reset
   
End Sub


Private Sub Workbook_BeforeClose(Cancel As Boolean)

    TimedClose_Reset
   
End Sub

Kevin
0
 
LVL 5

Author Comment

by:sir plus
ID: 35615840

 I thought memory was freed once a macro ended yet TimeToClose seems to stay resident which is a nice work around to not need the custom property........

Seems to work but not sure why mine failed so will test it for a couple of days and if no issues will award the points.

0
 
LVL 81

Expert Comment

by:zorvek (Kevin Jones)
ID: 35616910
Yours failed because you were stuffing the date/time value into another object (custom property) and then recovering it. This caused some rounding of the date/time value (a double value) and if it is not identical to the original used the timer won't be cancelled. By stuffing it into a date variable and using that variable to both create and cancel the timer we are guaranteed that it will be identical.

Kevin
0
 
LVL 5

Author Closing Comment

by:sir plus
ID: 35774596
I appreciate the explaination why it failed.

Is there a way to retrieve the times the macro will run.....?
0
 
LVL 81

Expert Comment

by:zorvek (Kevin Jones)
ID: 35774613
>Is there a way to retrieve the times the macro will run.....?

No, that information is not accessible.

Kevin
0

Featured Post

Free Tool: Site Down Detector

Helpful to verify reports of your own downtime, or to double check a downed website you are trying to access.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Q&A with Course Creator, Mark Lassoff, on the importance of HTML5 in the career of a modern-day developer.
If you are a mobile app developer and especially develop hybrid mobile apps then these 4 mistakes you must avoid for hybrid app development to be the more genuine app developer.
Excel styles will make formatting consistent and let you apply and change formatting faster. In this tutorial, you'll learn how to use Excel's built-in styles, how to modify styles, and how to create your own. You'll also learn how to use your custo…
Six Sigma Control Plans

580 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question