Excel Session timer 10min splash screen Warning then 15min force close

Workbook Code:

Private Sub Workbook_Open()

StartTimer10min

End Sub


Private Sub Workbook_BeforeClose(Cancel As Boolean)

StopTimer

End Sub

UserForm2 code:

Private Sub UserForm_Initialize()
Application.OnTime Now + TimeValue("00:00:07"), "KillForm"
End Sub

I don't know, maybe it's me but My unscheduling was giving me an error so I had to "On Error Resume Next like I did with the other unschedule. (bad programming I know) but it still does not stop it from re-opening.

This is part of my workbook code

Private Sub Workbook_BeforeClose(Cancel As Boolean)
StopTimer

On Error Resume Next
  Application.OnTime _
  EarliestTime:=Now + TimeValue("00:00:00"), _
  Procedure:="KillForm", _
  Schedule:=False
End Sub

Nevermind guysl... For some reason, Everytime I close the file it somehow automatically re-opens later.... This is quite frustrating. Any more Ideas? Maybe my approach is wrong?

In the main module, Sub StopTimer()

Ok, so I got it to work without the userform (Since it was giving me problems). instead of a splash screen, I created a msgbox Yes/No event with the same warning. So it goes like this:

After 10min of opening the file, the user is prompted with the message box saying they've "passed 10min save & close? You have 5 extra minutes" if Yes, then save and close workbook. If no, then a 5min timer starts and at the end of 5min it saves and closes automatically.

I call only the 10min start timer on workbook open, after message box I stop all timers and then begin the second timer. on workbook close I stop all timers.

Workbook code:

Private Sub Workbook_Open()
StartTimer10min
end sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
StopTimer
End Sub

Here is the module code:

Public RunWhen As Double
Public RunWhen2 As Double
Public Const cRunIntervalSeconds10 = 600    '10min
Public Const cRunWhat10 = "MsgPrompt"  ' the name of the procedure to run
Public Const cRunIntervalSeconds15 = 300 '15min
Public Const cRunWhat15 = "CloseAll"  ' the name of the 2nd procedure to run

'This program prompts the user after time has met a preset
Sub MsgPrompt()
Message
StopTimer
StartTimer15min
End Sub

Sub StartTimer10min()
    RunWhen = Now + TimeSerial(0, 0, cRunIntervalSeconds10)
    Application.OnTime EarliestTime:=RunWhen, Procedure:=cRunWhat10, _
        Schedule:=True
End Sub
Sub StartTimer15min()
    RunWhen2 = Now + TimeSerial(0, 0, cRunIntervalSeconds15)
    Application.OnTime EarliestTime:=RunWhen2, Procedure:=cRunWhat15, _
        Schedule:=True
End Sub

Sub StopTimer()
        On Error Resume Next
    Application.OnTime EarliestTime:=RunWhen, Procedure:=cRunWhat10, _
        Schedule:=False
        
        On Error Resume Next
    Application.OnTime EarliestTime:=RunWhen2, Procedure:=cRunWhat15, _
        Schedule:=False
 End Sub
 
Sub CloseAll()
'This closes the file, and saves any changes if changes were made
Workbooks("Suivi de projets Dpt 6450.xls").Close SaveChanges:=True
End Sub

Sub Message()


Dim Answer As String
Dim MyNote As String

    'Place your text here
    MyNote = "Your 10min session is up, you have 5min before auto save & close. Save&Close Now?"

    'Display MessageBox
    Answer = MsgBox(MyNote, vbQuestion + vbYesNo, "SESSION EXPIRED")

    If Answer = vbNo Then
    Exit Sub
        'Code for No button Press
    Else
        'Code for Yes button Press
    CloseAll
    End If
End Sub