View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.misc
Bob Phillips Bob Phillips is offline
external usenet poster
 
Posts: 10,593
Default Kicking Out Selective (Not all) Inactive Users

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" wrote in message
...

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, Procedu="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