Kicking Out Selective (Not all) Inactive Users

[Mike The Newb]

Thanks to Paul B I obtained a Standard Module and Workbook code to save and
close a file when there's no user interface for a given period of time
(active involvement - keystrokes, mouse clicks, etc). The original code was
set for 20 seconds, I changed it to five minutes.

My company "tags" users by a specific user name (abc1234 - initials and
employee number - always seven digits - three alpha and four numeric). When
someone is already in a file, the notify/read only pop up shows their
username. Somehow, Excel knows who’s in it, so it knows who’s opening it as
well. I would like to modify Paul B's code to exclude certain users from
being kicked out for inactivity. Is that possible?

The original code from Paul B was as follows:

'put this in a standard module
Dim DownTime As Date
Sub SetTime()
DownTime = Now + TimeValue("00:00:20")
Application.OnTime DownTime, "ShutDown"
End Sub

Sub ShutDown()
ThisWorkbook.Save
ThisWorkbook.Close
End Sub

Sub Disable()
On Error Resume Next
Application.OnTime EarliestTime:=DownTime, Procedure:="ShutDown",
Schedule:=False
End Sub

'put this in thisworkbook
Private Sub Workbook_Open()
MsgBox "This workbook will auto-close after 20 seconds of inactivity"
Call SetTime
End Sub

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

Private Sub Workbook_SheetCalculate(ByVal Sh As Object)
Call Disable
Call SetTime
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target
As Excel.Range)
Call Disable
Call SetTime
End Sub

Thanks in advance for your time and consideration.

Regards,

Mike

 

[Bob Phillips]

workbook code module


Private Sub Workbook_Open()
Select Case Environ("Username")
Case "abc1234", "joe9999", "bob" 'etc. case sensitive
Case Else:
MsgBox "This workbook will auto-close after 20 seconds of
inactivity"
Call SetTime
End Select
End Sub

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

Private Sub Workbook_SheetCalculate(ByVal Sh As Object)
Select Case Environ("Username")
Case "abc1234", "joe9999", "bob" 'etc. case sensitive
Case Else:
Call Disable
Call SetTime
End Select
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target
As Excel.Range)
Select Case Environ("Username")
Case "abc1234", "joe9999", "bob" 'etc. case sensitive
Case Else:
Call Disable
Call SetTime
End Select
End Sub


--
HTH

Bob Phillips

(replace somewhere in email address with gmail if mailing direct)

 

[Mike The Newb]

Bob,

Thanks for the code; as always, I put it into a test copy of the file I
intend to use it on.

I ran into a problem though, randomly (I can't cause it to occur) the file
will open itself, save and close itself. When it does occur, it is at the
established time interval within the code (for testing I used 20 seconds). It
only occurs for users that are not exempt from the code - not named as an
"exclude" within the code.

This oddity occurred for two different non exempt users. For one, it
occurred continuously every 20 seconds until he got out of Excel and then
back into it without opening the test file again. For another user, it only
occurred once and cannot be initiated again by repeating the events. In both
cases the users had another unrelated Excel file open as well.

Here's the code Workbook wise:

Private Sub Workbook_Open()
Select Case Environ("Username")
Case "hks0679"
Case Else:
MsgBox "This workbook will auto-close after 20 seconds of
inactivity"
Call SetTime
End Select
End Sub

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

Private Sub Workbook_SheetCalculate(ByVal Sh As Object)
Select Case Environ("Username")
Case "hks0679"
Case Else:
Call Disable
Call SetTime
End Select
End Sub


Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target
As Excel.Range)
Select Case Environ("Username")
Case "hks0679"
Case Else:
Call Disable
Call SetTime
End Select
End Sub

Module wise:

Dim DownTime As Date
Sub SetTime()
DownTime = Now + TimeValue("00:00:20")
Application.OnTime DownTime, "ShutDown"
End Sub

Sub ShutDown()
ThisWorkbook.Save
ThisWorkbook.Close
End Sub

Sub Disable()
On Error Resume Next
Application.OnTime EarliestTime:=DownTime, Procedure:="ShutDown",
Schedule:=False
End Sub

It's a random occurrence, at least I cannot cause it to happen by repeating
the initial steps or trying other step combinations in terms of the sequence
of opening files, when they're manually saved by users (possibly before 20
seconds), etc. When user hks0679 opens it, she receives no message regarding
the auto close in 20 seconds, the file doesn’t save and close itself in 20
seconds (those aspects work great) and she has no issues with it opening
itself after it has been closed out.

Any insight would be greatly appreciated. This is an awesome code and it has
a lot potential for a variety of files used daily by multiple users.

Regards,
Mike