save and close file after 30 minutes

Timing out a Workbook
Is there a way to set up a workbook so that if a user leaves it open and walks away from his/her machine, Excel will save the changes and close the workbook?

In my world, various people, across many states, open and edit some of the same workbooks via a network setup. We have not shared the workbooks because of some of the limitations that sharing causes. On a good day the user opens the workbook, makes the changes that are necessary, saves his/her changes, and closes the workbook thus allowing the next user to open it. However, we know every day is not a good day - on these "not so good days" days the user opens the workbook, makes some changes, gets distracted by a donut drop off, and walks off to investigate leaving the workbook open. Now the person is ATL whois trying to open it to make changes can only open as a READ-ONLY...

Does anyone have any suggestions?
_________________
Beth

13 Mar 2003 16:52


Richie(UK)
MrExcel MVP


Joined: 18 May 2002
Posts: 1428
Location: Worcester, England

Hi Beth,

See if this does what you need - it closes after 20 seconds of inactivity (defined in this case as no calculation or change of selection).

In a general module:

code:
--------------------------------------------------------------------------------
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
--------------------------------------------------------------------------------



In the ThisWorkbook object:
code:
--------------------------------------------------------------------------------
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

Click to expand...