Solved: Auto close inactive workbook, w/timed warning message, w/UserForm open test/reset

[bensko]

Took a while to piece this together and get it working properly. Big thanks to the experts who take the time to help out others!!!

Also huge thanks to Charlesh for personally mentoring me several years ago.

Upon workbook open:

MsgBox "THE WORKBOOK WILL SAVE AND CLOSE IF LEFT INACTIVE FOR 5 MINUTES"

After 5 minutes:

MsgBox "DO YOU STILL NEED THIS WORKBOOK OPEN? NO RESPONSE WILL CLOSE WORKBOOK IN 15 SECONDS"

YES (reset) or NO (close) or close if no action for 15 seconds.

Also will reset timer if a UserForm is open. Probably could add timer to the form code to prompt, save, and close, if left inactive.

Hope this helps someone out:

ThisWorkbook:

Option Explicit

'edit these three constants
Private Const Hours As Integer = 0
Private Const Minutes As Integer = 5
Private Const Seconds As Integer = 0

Private when As Variant

Private Sub Workbook_Open()
 MsgBox "THE WORKBOOK WILL CLOSE IF LEFT INACTIVE FOR 5 MINUTES"
 time_out (True)
End Sub

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
 restart
End Sub

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

Private Sub Workbook_Activate()
 restart
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
 cancel_schedule
End Sub

Sub restart()
 cancel_schedule
 time_out (True)
End Sub

Sub time_out(Optional flag As Boolean)
 'Erik Van Geit
 
 Dim action As Integer
 Dim file_name As String

 If flag Then
 when = Now + TimeSerial(Hours, Minutes, Seconds)
 Application.OnTime when, "ThisWorkbook.time_out"
 Exit Sub
 End If

If UserForms.Count = 1 Then
    time_out (True)
    Exit Sub
End If

MsgBoxDelay

If ActiveSheet.Range("BB1").Value = "X" Then
    time_out (True)
    ActiveSheet.Range("BB1").Value = ""
    Exit Sub
End If

 With ThisWorkbook
 cancel_schedule
 .Close True
 End With

End Sub

Private Sub cancel_schedule()
 On Error Resume Next
 Application.OnTime EarliestTime:=when, Procedure:="ThisWorkbook.time_out", schedule:=False
 On Error GoTo 0
End Sub

Module:

[I]Declare PtrSafe Function MessageBoxTimeout Lib "user32.dll" Alias "MessageBoxTimeoutA" ( _[/I]
[I]ByVal hwnd As Long, _[/I]
[I]ByVal lpText As String, _[/I]
[I]ByVal lpCaption As String, _[/I]
[I]ByVal uType As Long, _[/I]
[I]ByVal wLanguageID As Long, _[/I]
[I]ByVal lngMilliseconds As Long) As Long[/I]
 
 
[I]Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" ( _[/I]
[I]ByVal lpClassName As String, _[/I]
[I]ByVal lpWindowName As String) As Long[/I]
 
 
[I]Public retval As Long[/I]
 
 
[I]Public Sub MsgBoxDelay()[/I]
 
[I]    If UserForms.Count = 1 Then Exit Sub[/I]
 
[I]    Const cmsg As String = "DO YOU STILL NEED THIS WORKBOOK OPEN" & vbCrLf & vbCrLf & "NO RESPONSE WILL CLOSE WORKBOOK IN 15 SECONDS"[/I]
[I]    Const cTitle As String = "INACTIVITY CLOSE WARNING"[/I]
 
 
[I]    retval = MessageBoxTimeout(FindWindow(vbNullString, Title), cmsg, cTitle, 4, 0, 15000)[/I]
 
 
[I]    If retval = 32000 Then '32000 = no response from message box[/I]
[I]    GoTo 10[/I]
[I]    End If[/I]
   
[I]    If retval = 6 Then '6 = YES clicked on message box[/I]
[I]    ActiveSheet.Range("BB1").Value = "X"[/I]
[I]    End If[/I]
   
[I]    If retval = 7 Then '7 = NO clicked on message box[/I]
[I]    GoTo 10[/I]
[I]    End If[/I]
 
[I]10[/I]
 
[I]End Sub[/I]
 
[I]Sub cancel_schedule()[/I]
[I] On Error Resume Next[/I]
[I] Application.OnTime EarliestTime:=when, Procedure:="ThisWorkbook.time_out", schedule:=False[/I]
[I] On Error GoTo 0[/I]
[I]End Sub[/I]