Save and close after inactivity Causing crashing

[PaulOPTC]

Good Afternoon,

I am having an issues with a particular code:

http://www.tmehta.com/tmxl/dbfind_byid.asp?id=7

In the ThisWorkbook module:

Option Explicit
Private Sub Workbook_Open()
LastActivityTime = Now()
Check_Inactivity
End Sub

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
LastActivityTime = Now()
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
LastActivityTime = Now()
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
LastActivityTime = Now()
End Sub

And, in a standard moduleOption Explicit
Public LastActivityTime As Date
Sub Check_Inactivity()
Const Inactivity_Delay As Date = #12:05:00 AM#
If LastActivityTime + Inactivity_Delay < Now() Then
ThisWorkbook.Close True
Else
Application.OnTime LastActivityTime + Inactivity_Delay, "Check_Inactivity"
End If
End Sub



The code works perfectly to what I would like it to do, but often times it completely breaks my ability to open the spreadsheet at all.
It will get to 100%, then crash, or just not even show the excel window at all. It causes other sheets to crash.


Does anyone else have a better code that runs more efficiently?

Ideally it would save and close after 5 mins of inactivity.

Thank you!

 

[DanteAmor]

Try this:

In the ThisWorkbook module:

Option Explicit

Private Sub Workbook_BeforeClose(Cancel As Boolean)
  On Error Resume Next
  Application.OnTime Now, "Check_Inactivity", , False
End Sub

Private Sub Workbook_Open()
  LastActivityTime = Now()
  Check_Inactivity
End Sub

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
  LastActivityTime = Now()
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
  LastActivityTime = Now()
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
  LastActivityTime = Now()
End Sub

in a standard module:

Public LastActivityTime As Date
Public xNow

Sub Check_Inactivity()
  Dim Inactivity_Delay
                          'hours:minutes:seconds
  Inactivity_Delay = TimeValue("00:00:15")
  
  If LastActivityTime + Inactivity_Delay < Now() Then
    On Error Resume Next
    Application.OnTime xNow + Inactivity_Delay, "Check_Inactivity", , False
    ThisWorkbook.Close True
  Else
    xNow = Now
    Application.OnTime xNow + Inactivity_Delay, "Check_Inactivity"
  End If
End Sub

 

[PaulOPTC]

Try this:

In the ThisWorkbook module:

Option Explicit

Private Sub Workbook_BeforeClose(Cancel As Boolean)
  On Error Resume Next
  Application.OnTime Now, "Check_Inactivity", , False
End Sub

Private Sub Workbook_Open()
  LastActivityTime = Now()
  Check_Inactivity
End Sub

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
  LastActivityTime = Now()
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
  LastActivityTime = Now()
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
  LastActivityTime = Now()
End Sub

in a standard module:

Public LastActivityTime As Date
Public xNow

Sub Check_Inactivity()
  Dim Inactivity_Delay
                          'hours:minutes:seconds
  Inactivity_Delay = TimeValue("00:00:15")
 
  If LastActivityTime + Inactivity_Delay < Now() Then
    On Error Resume Next
    Application.OnTime xNow + Inactivity_Delay, "Check_Inactivity", , False
    ThisWorkbook.Close True
  Else
    xNow = Now
    Application.OnTime xNow + Inactivity_Delay, "Check_Inactivity"
  End If
End Sub

Awesome, Seems to be working!

I just set the time to 5 mins instead of 15 seconds (My guys are not the quickest spreadsheet users)

Ill let you know if I have any issues with it breaking my sheet.

 

[DanteAmor]

I'm glad to help you. Thanks for the feedback.