PDA

View Full Version : Time Out and auto close after expired time



Phelony
05-05-2009, 07:27 AM
Hi Guys :hi:

I'm trying to write a short piece of code to basically shut down excel if the user has been inactive for 5 minutes or longer.

The code I've got is adapted from something previously used in Access, however, I don't seem to be able to get it to work properly.

In short, if you haven't done anything to this workbook in 5 minutes it closes itself down. It doesn't need to save, it doesn't need to warn you, it just needs to boot you out. :hi:

Can anyone shed some light on where I've gone wrong?


Private Sub Form_Timer()
Const IDLEMINUTES = 0.01
Static ExpiredTime
Dim ActiveFormName As String
Dim ActiveControlName As String
Dim ExpiredMinutes

ExpiredMinutes = (ExpiredTime / 1000) / 60
If ExpiredMinutes >= IDLEMINUTES Then
ExpiredTime = 0
IdleTimeDetected
End If
End Sub
Sub IdleTimeDetected()
If TimerInterval = 30000 Then
Application.Quit
End If
End Sub

Thanks

Phel x

GTO
05-05-2009, 11:33 PM
Greetings Phel,

No real knowlege re Access, so not sure about that snippet. However, you could look here:
http://www.vbaexpress.com/kb/getarticle.php?kb_id=516

While Johnske's article shows how to exit windows, I think we could just do something like this:

In a Standard Module:

Option Explicit

Dim dtmExitTime As Date

Const Nn_1 As Double = 6.94444444444444E-04
Const Nn_5 As Double = 3.47222222222222E-03
Const Nn_10 As Double = 6.94444444444444E-03
Const Nn_15 As Double = 1.04166666666667E-02

Sub Timer_Start()
dtmExitTime = Time() + Nn_5 '<---Change to suite. Nn_1 is one minute, etc
Application.OnTime dtmExitTime, "Application_Exit"
End Sub

Sub Timer_Cancel()
On Error Resume Next
Application.OnTime dtmExitTime, "Application_Exit", , False
End Sub

Sub Application_Exit()
Dim wb As Workbook

For Each wb In Workbooks
If Not wb.Name = ThisWorkbook.Name Then
wb.Saved = True
wb.Close False
End If
Next
ThisWorkbook.Saved = True
Application.Quit
End Sub


In ThisWorkbook:

Option Explicit

Private Sub Workbook_Activate()
Call Timer_Cancel
Call Timer_Start
End Sub

Private Sub Workbook_Deactivate()
Call Timer_Cancel
Call Timer_Start
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Call Timer_Cancel
End Sub

Private Sub Workbook_BeforePrint(Cancel As Boolean)
Call Timer_Cancel
Call Timer_Start
End Sub

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Call Timer_Cancel
Call Timer_Start
End Sub

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Call Timer_Cancel
Call Timer_Start
End Sub

Private Sub Workbook_SheetCalculate(ByVal Sh As Object)
Call Timer_Cancel
Call Timer_Start
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Call Timer_Cancel
Call Timer_Start
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Call Timer_Cancel
Call Timer_Start
End Sub


Not super well tested, but I think I'm fairly awake...

Hope this helps,

Mark

PS - I wouldn't think you'd need to plant it in that many events, but just to show. As long as you have stuff picked that you know will be happening if you haven't walked away...