OnTime+TimeValue + Autoclose

P

puba

The following code aims to allow data input into the spreadsheet, and
then close it as soon as possible, rather than keeping it open, so that
others can also input data.
When opening the workbook, you get a warning message that you should
aim to close it within 10 minutes.
Then, 10 minutes later, you get a message box suggesting to exit ans
save the workbook.
All this works fine.

PROBLEM
If you close the workbook in less than 10 minutes, the workbook reopens
itself to display the warning "Please exit database if not in use."
This is really silly because the operator did the right thing to close
the book promptly, and now the book is open again...

QUESTION
Can I make the macro conditional (to run only if the workbook is still
open)?

Thanks,
Puba

-----------------------------------------
Sub auto_Open()
MsgBox "You will get a prompt for saving and exiting the file after 10
minutes."
Application.OnTime Now + TimeValue("00:10:00"), "autoclose"
End Sub
-------------------------------------
Sub autoclose()
MsgBox "Please exit database if not in use." & Chr(13) & "..." &
Chr(13) & "Click Cancel in following screen to remain in the helpdesk
database, you will not get another prompt."
' closes the active workbook and lets the user decide if
' changes are to be saved or not
ActiveWorkbook.Close
End Sub
---------------------------------
 
P

puba

This workbook
-------------

Private Sub Workbook_BeforeClose(Cancel As Boolean)
MsgBox "Closing timer: " & nextime
On Error GoTo xxx
Application.OnTime nextime, "chkexit", , False
MsgBox "timer cancelled"
Exit Sub
xxx:
MsgBox "error while cancelling the timer"
End Sub

Private Sub Workbook_Open()
delay = TimeValue("00:00:50")
nextime = Now + delay
MsgBox "You will get a prompt for saving and exiting after " & delay &
" which is at " & nextime
Application.OnTime nextime, "chkexit", , True

End Sub



module1
--------
'Type the following two lines in the declarations section
Public nextime As Date
Public delay As Date

Sub chkexit()
If MsgBox("The timer " & nextime & " has elapsed.Do you want to
continue working", vbYesNo) = vbYes Then
nextime = Now + delay
MsgBox "You will get another prompt in " & delay & "which is at " &
nextime
Application.OnTime nextime, "chkexit", , True
Else
ActiveWorkbook.Close
End If
End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top