Please check this "demo time check" procedure and suggest improvements!

[Gunnar Johansson]

HI,

This is a procedure that test if the number of days allowed to
test/"evalutate" a file is passed or not. If the "evalutation time" is due,
there is a msgbox telling so and then closing the file. I have it into
ThisWorkbook module in Workbook_Open event.

Please read the code through and suggest improvements. I know one flaw:
With the "ActiveWorkbook.Close" statement you get a msgbox asking if you
want to save the file. If you choose "Cancel" there, you are into the file
anyway. Is there a statement closing the woorkbook without asking to save?

If you choose to open it without macro allowed, you open the file but I
don't count it to do any harm, since any of the actual functions are gone
with the macros. It's could be ok to look into the workbooks, they can't run
the actual meaing with the file anyhow. But of cource, do you know any way
to stop that, please suggest the solution, that is more "clean".

What more have I missed??
_________________

Sub TimeLimit()
' ************
On Error GoTo errorH
Dim dateStart As Date
Dim daysAllow As Long
Dim daysLeft As Long
Dim daysPassed As Long
Application.EnableEvents = False
Application.ScreenUpdating = False

' Set allowed days to test XL file ["cell GUI" as hidden cell ]
daysAllow = Sheet1.Range("S21").Cells.Value ' like 30 days etc

' Start to count the first time and set start date in a(hidden) cell
If Sheet1.Range("S20").Cells.Value = "" Then
dateStart = Now
Sheet1.Range("S20").Cells.Value = dateStart
End If

' Calculate days left
If Sheet1.Range("S20").Cells.Value <> "" Then
daysPassed = DateDiff("d", Sheet1.Range("S20").Cells.Value, Now)

If daysPassed < daysAllow Then
daysLeft = daysAllow - daysPassed
MsgBox "You have " & daysLeft & " days left to evaluate!"

ElseIf daysPassed >= daysAllow Then
MsgBox "No time left to evaluate!"

Application.EnableEvents = True
Application.ScreenUpdating = True
ActiveWorkbook.Close
Exit Sub

End If
End If

Application.EnableEvents = True
Application.ScreenUpdating = True
Exit Sub

errorH:
MsgBox "No time left to evaluate!""

Application.EnableEvents = True
Application.ScreenUpdating = True
ActiveWorkbook.Close
Exit Sub

End Sub

 

[Jim Rech]

I know one flaw: With the "ActiveWorkbook.Close" statement

Take a look at the SaveChanges argument of the Close method.

After you write the initial use date in the workbook what forces the user to
save it?