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
|