Auto Close, after X minutes-code not working

[froggiebeckie]

I've got a couple of files posted on a shared drive, so multiple folks can access them.

One (Schedule) has code to save and close after 30 minutes, since folks are prone to open and then walk away from their desks.
It works fine.

But, when I tried to use the same code on the second file (MDL), it doesn't work.

Both are .xlsm files
Can anyone suggest what the issue may be?

Thanks,
BeckieO

Here are the codes for the 2 files.

MDL
'PLACE THIS CODE IN MODULE 1:
'******************************

Dim BootTime As Date

Sub StartTime()


'Start the Timer
BootTime = Now + TimeValue("00:30:10") 'Set your time here
Application.OnTime BootTime, "ShutDown"
End Sub

Sub ShutDown()


'At this point the main timer has elapsed.
Application.WindowState = xlMaximized 'Maximize window
Application.DisplayAlerts = False 'suppresses all messages about saving
ActiveWorkbook.Close savechanges:=True 'FALSE = changes are not saved

ThisWorkbook.Close
End Sub


Sub Disable()


'Stop the Timer
On Error Resume Next
Application.OnTime EarliestTime:=BootTime, _
Procedure:="ShutDown", Schedule:=False
End Sub


CLASS 1

Private Sub workbook_open()

End Sub
'start timer
Call StartTime

Private Sub workbook_beforeclose(canecel As Boolean)
'Stop the timer
Call Disable

End Sub









SCHED
'PLACE THIS CODE IN MODULE 1:
'******************************

Dim BootTime As Date

Sub StartTime()


'Start the Timer
BootTime = Now + TimeValue("00:30:10") 'Set your time here
Application.OnTime BootTime, "ShutDown"
End Sub

Sub ShutDown()


'At this point the main timer has elapsed.
Application.WindowState = xlMaximized 'Maximize window
Application.DisplayAlerts = False 'suppresses all messages about saving
ActiveWorkbook.Close savechanges:=True 'FALSE = changes are not saved

ThisWorkbook.Close
End Sub


Sub Disable()


'Stop the Timer
On Error Resume Next
Application.OnTime EarliestTime:=BootTime, _
Procedure:="ShutDown", Schedule:=False
End Sub


CLASS 1
Private Sub workbook_open()

End Sub
'start timer
Call StartTime

Private Sub workbook_beforeclose(canecel As Boolean)
'Stop the timer
Call Disable

End Sub

 

[froggiebeckie]

OK, never mind.
Found some simpler code that works fine, so I'll just chalk this one up to the Magic of Excel.

Thanks anyway.
Here's what worked:

ALT+F11 to open VB editor. Double click 'ThisWorkbook' and paste the first 2 modules in on the right.


Private Sub Workbook_Open()
StartTimer
End Sub

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


Now right click 'ThisWorkbook' insert module and paste this code in. Save close and re-open the workbook and after 15 minutes of idle time it will save and close automatically.


Const idleTime = 900 'seconds
Dim Start
Sub StartTimer()
Start = Timer
Do While Timer < Start + idleTime
DoEvents
Loop
Application.DisplayAlerts = False
ActiveWorkbook.Close True
Application.DisplayAlerts = True
End Sub