Excel warning

[bakerd]

We use Excel for our office sign in and sign out. This works very well for us until someone needs to sign out and needs to leave NOW, but some nimrod has opened the sign out sheet to view the status of others or to sign out themselves and walked away, got on the phone or is visiting with someone and has forgotten to save and close.
As system administrator I constantly have to go to the server's Share and Storage Management Console's "Manage Open Files" utility to force a close on the sign out sheet. I would like to know if there is a way that the Excel sign out sheet could automatically save and close after non-use of say 1 minute or less. Or maybe there is some way to have it so when another user needs to open the sign out and they receive the message that it is open and in use and locked by another user that this new user could somehow override and open or somehow close it on the other users PC. And if that isn't bad enough there are many times that the "in use by another user and locked message" says it is in use by a specific user when in fact it is in use by someone else. The system sometimes does not report correctly who truly has the file open. WHAT A MESS!! I have searched high and low for a cheap or reasonably priced sign in - sign out software, but so far have not had much success finding a good one that can be modified and is such that all users can have the program open simultaneously and have instant reporting of changes to employees' status.

 

[AD_Taylor]

I see you probably have a solution now but for anyone else looking here's another way to do it. You mentioned in the first post about having the file automatically close if the user had been on for too long. Here is a way to do that.

1. Open the file and press Alt + F11 to open the VBA Editor.
2. Open the ThisWorkbook module (under Excel Objects in the left window)
3. Paste all of the code below into that window and then save the file. It will need to be a .xlsm if saving as 2007/2010 format.
4. Manually close and open the workbook (with macros enabled)
5. Wait 1 min (or whatever value set in the interval variable) and the workbook should close itself.

Here's the code

Option Explicit
Dim nextTick
Const strInterval As String = "00:01:00" 'Change this to change the amount of time before the user is kicked

Private Sub Workbook_Open()
'When Workbook is opened start timer that will run kick procedure when timer ends
    nextTick = Now + TimeValue(strInterval)
    Application.OnTime nextTick, "SaveAndKickUser"
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
'When Workbook is closed remove the timer event
    On Error Resume Next
    Application.OnTime nextTick, "SaveAndKickUser", , False
End Sub

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
'When the Workbook is saved stop and restart the timer // Assuming a Save means the user is still active on the sheet
    On Error Resume Next
    Application.OnTime nextTick, "SaveAndKickUser", , False
    
    nextTick = Now + TimeValue(strInterval)
    Application.OnTime nextTick, "SaveAndKickUser"
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
'When any cell value is changed stop and restart the timer
    On Error Resume Next
    Application.OnTime nextTick, "SaveAndKickUser", , False
    
    nextTick = Now + TimeValue(strInterval)
    Application.OnTime nextTick, "SaveAndKickUser"
End Sub

Private Sub SaveAndKickUser()
'The actual process that saves the Workbook and then auto closes it
    ThisWorkbook.Save
    ThisWorkbook.Close True
End Sub

 

[bakerd]

I see you probably have a solution now but for anyone else looking here's another way to do it. You mentioned in the first post about having the file automatically close if the user had been on for too long. Here is a way to do that.

1. Open the file and press Alt + F11 to open the VBA Editor.
2. Open the ThisWorkbook module (under Excel Objects in the left window)
3. Paste all of the code below into that window and then save the file. It will need to be a .xlsm if saving as 2007/2010 format.
4. Manually close and open the workbook (with macros enabled)
5. Wait 1 min (or whatever value set in the interval variable) and the workbook should close itself.

Here's the code

Option Explicit
Dim nextTick
Const strInterval As String = "00:01:00" 'Change this to change the amount of time before the user is kicked

Private Sub Workbook_Open()
'When Workbook is opened start timer that will run kick procedure when timer ends
    nextTick = Now + TimeValue(strInterval)
    Application.OnTime nextTick, "SaveAndKickUser"
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
'When Workbook is closed remove the timer event
    On Error Resume Next
    Application.OnTime nextTick, "SaveAndKickUser", , False
End Sub

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
'When the Workbook is saved stop and restart the timer // Assuming a Save means the user is still active on the sheet
    On Error Resume Next
    Application.OnTime nextTick, "SaveAndKickUser", , False
    
    nextTick = Now + TimeValue(strInterval)
    Application.OnTime nextTick, "SaveAndKickUser"
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
'When any cell value is changed stop and restart the timer
    On Error Resume Next
    Application.OnTime nextTick, "SaveAndKickUser", , False
    
    nextTick = Now + TimeValue(strInterval)
    Application.OnTime nextTick, "SaveAndKickUser"
End Sub

Private Sub SaveAndKickUser()
'The actual process that saves the Workbook and then auto closes it
    ThisWorkbook.Save
    ThisWorkbook.Close True
End Sub

Thank you so much for this tip, I will give it a try.

 

[bakerd]

Thank you so much for this tip, I will give it a try.

I am ready to try this, but in the left window there is not a "ThisWorkbook module (under Excel Objects in the left window)". It would seem that without this little tidbit I cannot proceed. There is not even an Excel Objects in the left window. If I could here I would post a screen shot of what I am seeing, but I don't see any way to do that.

 

[AD_Taylor]

The best way I know to post a screenshot is to use a hosting site like photobucket or imgur and then just post a link to the picture.

However before that it's possible you don't have the Project Explorer window open. Try going to View > Project Explorer or pressing Ctrl + R, in the VBA window. This should open it on the left of the screen. If it's still not there then please post the screenshot.

 

[bakerd]

The best way I know to post a screenshot is to use a hosting site like photobucket or imgur and then just post a link to the picture.

However before that it's possible you don't have the Project Explorer window open. Try going to View > Project Explorer or pressing Ctrl + R, in the VBA window. This should open it on the left of the screen. If it's still not there then please post the screenshot.

Well I finally got it to working to a point that point being when the macro begins to run I get the message regarding cannot run macro - see http://i.imgur.com/LrDSc.png

I have tried everything I can think of regarding the trust center, but to no avail.

 

[AD_Taylor]

Sorry my fault, got some of the references wrong. Try the code below should work without a problem this time,

Option Explicit
Dim nextTick
Const strInterval As String = "00:01:00" 'Change this to change the amount of time before the user is kicked

Private Sub Workbook_Open()
'When Workbook is opened start timer that will run kick procedure when timer ends
    nextTick = Now + TimeValue(strInterval)
    Application.OnTime nextTick, "ThisWorkbook.SaveAndKickUser"
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
'When Workbook is closed remove the timer event
    On Error Resume Next
    Application.OnTime nextTick, "ThisWorkbook.SaveAndKickUser", , False
End Sub

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
'When the Workbook is saved stop and restart the timer // Assuming a Save means the user is still active on the sheet
    On Error Resume Next
    Application.OnTime nextTick, "ThisWorkbook.SaveAndKickUser", , False
    
    nextTick = Now + TimeValue(strInterval)
    Application.OnTime nextTick, "ThisWorkbook.SaveAndKickUser"
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
'When any cell value is changed stop and restart the timer
    On Error Resume Next
    Application.OnTime nextTick, "ThisWorkbook.SaveAndKickUser", , False
    
    nextTick = Now + TimeValue(strInterval)
    Application.OnTime nextTick, "ThisWorkbook.SaveAndKickUser"
End Sub

Public Sub SaveAndKickUser()
'The actual process that saves the Workbook and then auto closes it
    ThisWorkbook.Save
    ThisWorkbook.Close True
End Sub

 

[Fazza]

FYI http://www.cpearson.com/excel/TimedClose.htm

 

[AD_Taylor]

Thanks Fazza, didn't know cpearson had an article on this! I use them as my go to reference for a lot of other things though.

Just so my code is fully up to date this should work without a problem:

Option Explicit
Dim nextTick
Const strInterval As String = "00:01:00" 'Change this to change the amount of time before the user is kicked

Private Sub Workbook_Open()
'When Workbook is opened start timer that will run kick procedure when timer ends
    nextTick = Now + TimeValue(strInterval)
    Application.OnTime nextTick, "ThisWorkbook.SaveAndKickUser"
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
'When Workbook is closed remove the timer event
    On Error Resume Next
    Application.OnTime nextTick, "ThisWorkbook.SaveAndKickUser", , False
End Sub

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
'When the Workbook is saved stop and restart the timer // Assuming a Save means the user is still active on the sheet
    On Error Resume Next
    Application.OnTime nextTick, "ThisWorkbook.SaveAndKickUser", , False
    
    nextTick = Now + TimeValue(strInterval)
    Application.OnTime nextTick, "ThisWorkbook.SaveAndKickUser"
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
'When any cell value is changed stop and restart the timer
    On Error Resume Next
    Application.OnTime nextTick, "ThisWorkbook.SaveAndKickUser", , False
    
    nextTick = Now + TimeValue(strInterval)
    Application.OnTime nextTick, "ThisWorkbook.SaveAndKickUser"
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
'When the user changes the active cell stop and restart the timer
    On Error Resume Next
    Application.OnTime nextTick, "ThisWorkbook.SaveAndKickUser", , False
    
    nextTick = Now + TimeValue(strInterval)
    Application.OnTime nextTick, "ThisWorkbook.SaveAndKickUser"
End Sub

Public Sub SaveAndKickUser()
'The actual process that saves the Workbook and then auto closes it
    ThisWorkbook.Save
    ThisWorkbook.Close True
End Sub

I've just added the event that resets the timer when a selection change is made.

 

[bakerd]

Sorry my fault, got some of the references wrong. Try the code below should work without a problem this time,

Option Explicit
Dim nextTick
Const strInterval As String = "00:01:00" 'Change this to change the amount of time before the user is kicked

Private Sub Workbook_Open()
'When Workbook is opened start timer that will run kick procedure when timer ends
    nextTick = Now + TimeValue(strInterval)
    Application.OnTime nextTick, "ThisWorkbook.SaveAndKickUser"
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
'When Workbook is closed remove the timer event
    On Error Resume Next
    Application.OnTime nextTick, "ThisWorkbook.SaveAndKickUser", , False
End Sub

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
'When the Workbook is saved stop and restart the timer // Assuming a Save means the user is still active on the sheet
    On Error Resume Next
    Application.OnTime nextTick, "ThisWorkbook.SaveAndKickUser", , False
    
    nextTick = Now + TimeValue(strInterval)
    Application.OnTime nextTick, "ThisWorkbook.SaveAndKickUser"
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
'When any cell value is changed stop and restart the timer
    On Error Resume Next
    Application.OnTime nextTick, "ThisWorkbook.SaveAndKickUser", , False
    
    nextTick = Now + TimeValue(strInterval)
    Application.OnTime nextTick, "ThisWorkbook.SaveAndKickUser"
End Sub

Public Sub SaveAndKickUser()
'The actual process that saves the Workbook and then auto closes it
    ThisWorkbook.Save
    ThisWorkbook.Close True
End Sub

Thank you so much, this is working fabulous.

 

[AD_Taylor]

Great thanks for the feedback

Just noticing that you have quoted the code in my post #16. You may want to update it with the code in post #18 as this has a fuller check to see if the user is still active, i.e. it checks if the user is selecting different cells, not just changing cell values.