close a workbook after 5 minutes

M

Marilyn

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
 
C

Chip Pearson

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)
 
C

Chip Pearson

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)
 
D

Dave Peterson

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.
 
M

Marilyn

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
 
D

Dave Peterson

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).
 
T

Tony S.

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
 
D

Dave Peterson

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.
 
T

Tony S.

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
 
D

Dave Peterson

Did you put all that code in the ThisWorkbook module?

If not, then move it there. (delete the copy of the old code)
 
T

Tony S.

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.
 
D

Dave Peterson

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...
 
Top