close a workbook after 5 minutes

  • Thread starter Thread starter Guest
  • Start date Start date
G

Guest

Hello I have a workbook that is in a network and about 20 people have access
to it . the problem is that sometimes they forget to close the file and no
one else can use it. Is there a way to put a time limit on a workbook, so
that the book will automatically close after 5 minutes - giving a warning to
the user before closing. THANKS
 
Marilyn,

In VBA, go to the Tools menu, choose References, and check "Windows Script
Host Object Model". The paste all the code below in to the ThisWorkbook code
module. Change the value of C_TEST_OPEN_SECONDS to the number of seconds
that the workbook should stay open without any user interaction.

See also http://www.cpearson.com/excel/TimedClose.htm



Option Explicit
Option Compare Text


Private LastTime As Double
Private RunWhen As Double
Private Const C_TEST_OPEN_SECONDS = 600 '<<< CHANGE


Private Sub Workbook_Open()
RunWhen = Now + TimeSerial(0, 0, C_TEST_OPEN_SECONDS)
Application.OnTime RunWhen, "ThisWorkbook.CloseMe", , True
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target
As Range)
On Error Resume Next
Application.OnTime RunWhen, "ThisWorkbook.CloseMe", , False
RunWhen = Now + TimeSerial(0, 0, C_TEST_OPEN_SECONDS)
Application.OnTime RunWhen, "ThisWorkbook.CloseMe", , True
End Sub

Public Sub CloseMe()

Dim IWSH As IWshRuntimeLibrary.WshShell
Set IWSH = New IWshRuntimeLibrary.WshShell
If IWSH.Popup(Text:="Your time is up. Keep open?", _
secondstowait:=3, Type:=vbYesNo + vbDefaultButton2) = -1 Then
Me.Close savechanges:=True
End If
End Sub


--
Cordially,
Chip Pearson
Microsoft MVP - Excel
Pearson Software Consulting, LLC
www.cpearson.com
(email address is on the web site)
 
Marilyn,

Take a lookat this thread here:

http://tinyurl.com/2hl9ym

But note as was pointed out to me if someone leaves it sheet in edit mode
then the macros will not run.

--
HTH

Sandy
In Perth, the ancient capital of Scotland
and the crowning place of kings

(e-mail address removed)
(e-mail address removed) with @tiscali.co.uk
 
The code I posted was incomplete. Use the following code in the ThisWorkbook
module:


Option Explicit
Option Compare Text


Private RunWhen As Double
Private Const C_TEST_OPEN_SECONDS = 5


Private Sub Workbook_BeforeClose(Cancel As Boolean)
On Error Resume Next
Application.OnTime RunWhen, "ThisWorkbook.CloseMe", , False
End Sub

Private Sub Workbook_Open()
RunWhen = Now + TimeSerial(0, 0, C_TEST_OPEN_SECONDS)
Application.OnTime RunWhen, "ThisWorkbook.CloseMe", , True
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target
As Range)
On Error Resume Next
Application.OnTime RunWhen, "ThisWorkbook.CloseMe", , False
RunWhen = Now + TimeSerial(0, 0, C_TEST_OPEN_SECONDS)
Application.OnTime RunWhen, "ThisWorkbook.CloseMe", , True
End Sub

Public Sub CloseMe()

Dim IWSH As IWshRuntimeLibrary.WshShell
Dim Res As Long
Set IWSH = New IWshRuntimeLibrary.WshShell

Res = IWSH.Popup(Text:="Your time is up. Keep open?", _
secondstowait:=3, Type:=vbYesNo + vbDefaultButton2)
If (Res = -1) Or (Res = vbNo) Then
On Error Resume Next
Application.OnTime RunWhen, "ThisWorkbook.CloseMe", , False
Me.Close savechanges:=True
End If

RunWhen = Now + TimeSerial(0, 0, C_TEST_OPEN_SECONDS)
Application.OnTime RunWhen, "ThisWorkbook.CloseMe", , True

End Sub




--
Cordially,
Chip Pearson
Microsoft MVP - Excel
Pearson Software Consulting, LLC
www.cpearson.com
(email address is on the web site)
 
Just curious.

How you gonna handle it if the user didn't want to save and your code saves the
file?

How you gonna handle it if the user wants to save and your code doesn't save the
changes?

This seems like a dangerous idea to me.
 
Dave Paterson ....the entries to this file should not take longer than 3
minutes to complete. Some people open the workbook make the entry and walk
away or just forget about it. I want to make sure that the workbooks closes
so other people can access the fiile and make their entries. I will test
this for a few days before I roll it out. If you have any other suggestions
, please let me know Thanks
 
You could modify this line in Chip's code.

Me.Close savechanges:=True
to
Me.Close savechanges:=False

It's your choice as the developer.

But I know that if you choose to save, then I can foul up a lot of things in 3
minutes. If I delete a bunch of data -- or few worksheets, then when your code
saves the changes, the workbook could be fouled up pretty good.

And if you choose to close without saving, then I could spend 24 hours updating
this file. Your code just waits for a 3 minute quiet time. If I don't change
selection within your time limit, then you close without saving, you should be
prepared for the crying/yelling.

I just don't know how any developer can know enough to close with a save or
close without saving.

It scares me (from a user perspective).
 
Hi Chip/Dave.

I have a real need for this routine, but I copied and pasted it exactly as
written; saved the file and nothing happens. Any ideas?

Here is the code as pasted into ThisWorkbook:

Option Explicit
Option Compare Text


Private RunWhen As Double
Private Const C_TEST_OPEN_SECONDS = 5


Private Sub Workbook_BeforeClose(Cancel As Boolean)
On Error Resume Next
Application.OnTime RunWhen, "ThisWorkbook.CloseMe", , False
End Sub

Private Sub Workbook_Open()
RunWhen = Now + TimeSerial(0, 0, C_TEST_OPEN_SECONDS)
Application.OnTime RunWhen, "ThisWorkbook.CloseMe", , True
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target
As Range)
On Error Resume Next
Application.OnTime RunWhen, "ThisWorkbook.CloseMe", , False
RunWhen = Now + TimeSerial(0, 0, C_TEST_OPEN_SECONDS)
Application.OnTime RunWhen, "ThisWorkbook.CloseMe", , True
End Sub

Public Sub CloseMe()

Dim IWSH As IWshRuntimeLibrary.WshShell
Dim Res As Long
Set IWSH = New IWshRuntimeLibrary.WshShell

Res = IWSH.Popup(Text:="Your time is up. Keep open?", _
secondstowait:=3, Type:=vbYesNo + vbDefaultButton2)
If (Res = -1) Or (Res = vbNo) Then
On Error Resume Next
Application.OnTime RunWhen, "ThisWorkbook.CloseMe", , False
Me.Close savechanges:=True
End If

RunWhen = Now + TimeSerial(0, 0, C_TEST_OPEN_SECONDS)
Application.OnTime RunWhen, "ThisWorkbook.CloseMe", , True

End Sub
 
You have to reopen the workbook to get the workbook_Open event to fire (or run
it manually).

And make sure you allow macros to run when you open the workbook.
 
Dave,
Macros are allowed to run on opening.
I ran the sub and get the following error:

"Compile Error:
Invalid use of Me keyword"

Public Sub CloseMe() highlights in yellow
 
Did you put all that code in the ThisWorkbook module?

If not, then move it there. (delete the copy of the old code)
 
That did it Dave. I had the code in both the ThisWorkbook and Module1. Thank
you.

Can you please tell me if this code will work in a SharePoint environment.
If so, what may need to change.

I've read you valid concerns regarding auto-saving possibly unwanted or
partial data, but the data shared in this file is not critical if it gets
corrupt; just inconvienent.
 
I've never used Sharepoint, so I don't even have a guess.

Good luck.
That did it Dave. I had the code in both the ThisWorkbook and Module1. Thank
you.

Can you please tell me if this code will work in a SharePoint environment.
If so, what may need to change.

I've read you valid concerns regarding auto-saving possibly unwanted or
partial data, but the data shared in this file is not critical if it gets
corrupt; just inconvienent.
Click to expand...
 
I have this code copied exactly as below but when the prompt comes up if you leave it idle and do not check anything the document does not close is there something else i need to add or do i have an error in my coding?

Thanks

Robert


Option Explicit
Option Compare Text


Private RunWhen As Double
Private Const C_TEST_OPEN_SECONDS = 60


Private Sub Workbook_BeforeClose(Cancel As Boolean)
On Error Resume Next
Application.OnTime RunWhen, "ThisWorkbook.CloseMe", , False
End Sub

Private Sub Workbook_Open()
RunWhen = Now + TimeSerial(0, 0, C_TEST_OPEN_SECONDS)
Application.OnTime RunWhen, "ThisWorkbook.CloseMe", , True
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
On Error Resume Next
Application.OnTime RunWhen, "ThisWorkbook.CloseMe", , False
RunWhen = Now + TimeSerial(0, 0, C_TEST_OPEN_SECONDS)
Application.OnTime RunWhen, "ThisWorkbook.CloseMe", , True
End Sub

Public Sub CloseMe()

Dim IWSH As IWshRuntimeLibrary.WshShell
Dim Res As Long
Set IWSH = New IWshRuntimeLibrary.WshShell

Res = IWSH.Popup(Text:="This Work Will Close so that Others Can use it. Do you Need To Keep open?", _
secondstowait:=3, Type:=vbYesNo + vbDefaultButton2)
If (Res = -1) Or (Res = vbNo) Then
On Error Resume Next
Application.OnTime RunWhen, "ThisWorkbook.CloseMe", , False
Me.Close savechanges:=True
End If

RunWhen = Now + TimeSerial(0, 0, C_TEST_OPEN_SECONDS)
Application.OnTime RunWhen, "ThisWorkbook.CloseMe", , True
 
That self-closing MsgBox is not reliable, as you discovered.
Better to display a userform and then close it after x seconds.
--
Jim Cone
Portland, Oregon USA
http://www.contextures.com/excel-sort-addin.html

..
..

"Robert Richie" <[email protected]>
wrote in message I have this code copied exactly as below but when the prompt comes up if you leave it idle and do not check anything the document
does not close is there something else i need to add or do i have an error in my coding?
Thanks
Robert


Option Explicit
Option Compare Text
Private RunWhen As Double
Private Const C_TEST_OPEN_SECONDS = 60

Private Sub Workbook_BeforeClose(Cancel As Boolean)
On Error Resume Next
Application.OnTime RunWhen, "ThisWorkbook.CloseMe", , False
End Sub

Private Sub Workbook_Open()
RunWhen = Now + TimeSerial(0, 0, C_TEST_OPEN_SECONDS)
Application.OnTime RunWhen, "ThisWorkbook.CloseMe", , True
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
On Error Resume Next
Application.OnTime RunWhen, "ThisWorkbook.CloseMe", , False
RunWhen = Now + TimeSerial(0, 0, C_TEST_OPEN_SECONDS)
Application.OnTime RunWhen, "ThisWorkbook.CloseMe", , True
End Sub

Public Sub CloseMe()

Dim IWSH As IWshRuntimeLibrary.WshShell
Dim Res As Long
Set IWSH = New IWshRuntimeLibrary.WshShell

Res = IWSH.Popup(Text:="This Work Will Close so that Others Can use it. Do you Need To Keep open?", _
secondstowait:=3, Type:=vbYesNo + vbDefaultButton2)
If (Res = -1) Or (Res = vbNo) Then
On Error Resume Next
Application.OnTime RunWhen, "ThisWorkbook.CloseMe", , False
Me.Close savechanges:=True
End If

RunWhen = Now + TimeSerial(0, 0, C_TEST_OPEN_SECONDS)
Application.OnTime RunWhen, "ThisWorkbook.CloseMe", , True
 
Back
Top