How to time-limit an Excel file installation

  • Thread starter Thread starter Colin Hayes
  • Start date Start date
Hi Gord

Thanks for your patience with this one. I tried this out on another
machine with identical results. I then tried varying the number of days
contained in Private Const C_NUM_DAYS_UNTIL_EXPIRATION

These were the results :

1 = 39569
3 = 39630
5 = 39692
10 = "14/01/2008"
15 = "19/01/2008"
20 = "24/01/2008"
25 = "29/01/2008"
30 = 39509
35 = 39662
50 = "23/02/2008"

I'm really surprised at these. I don't know why they would be given in
different formats. It makes me think that the date coding in the macro
is wrong somehow. It seems that the results which give full dates with
speech marks are all correct (given the system date of 04/01/2008) , but
all the numerical results are wrong. I looked at the Chip Pearson site ,
and it seems none of the numerical results equate correctly , and
wouldn't work.

This is the macro exactly as I'm running it :



Private Const C_NUM_DAYS_UNTIL_EXPIRATION = 30

'change number above for amount of days until expiry

'Making The Code Run At Open. ( It will not work if you don't do this!)

' Call the procedure for the Workbook_Open event procedure
' in the ThisWorkbook code module under the excel icon top left.

'Private Sub Workbook_Open()
' TB
'End Sub


Sub TB()
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' TB
' This procedure uses a defined name to store this workbook's
' expiration date. If the expiration date has passed, a
' MsgBox is displayed and this workbook is closed.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim ExpirationDate As String
Dim NameExists As Boolean

On Error Resume Next
ExpirationDate = Mid(ThisWorkbook.Names("ExpirationDate").Value, 2)
If Err.Number <> 0 Then
'''''''''''''''''''''''''''''''''''''''''''
' Name doesn't exist. Create it.
'''''''''''''''''''''''''''''''''''''''''''
NameExists = False
ExpirationDate = CStr(DateSerial(Year(Now), _
Month(Now), Day(Now) + C_NUM_DAYS_UNTIL_EXPIRATION))
ThisWorkbook.Names.Add Name:="ExpirationDate", _
RefersTo:=Format(ExpirationDate, "short date"), _
Visible:=False
Else
NameExists = True
End If

''''''''''''''''''''''''''''''''''''''''''''''''''''''
' If the today is past the expiration date, close the
' workbook. If the defined name didn't exist, we need
' to Save the workbook to save the newly created name.
''''''''''''''''''''''''''''''''''''''''''''''''''''''
If CDate(Now) > CDate(ExpirationDate) Then
MsgBox "Your trial period has now expired.", vbOKOnly
ThisWorkbook.Close savechanges:=False
End If

End Sub


Can you see any error in here?

Thanks Gord.



Best Wishes


Colin








Gord Dibben said:
39360 is the serial number for October 7, 2007....for more on Excel date serials
see Chip's site at http://www.cpearson.com/excel/datetime.htm#SerialDates

Did you delete the "Expiration Date" name from Insert>Name>Define?

Do so, then save the workbook, close and reopen to reset the expiration date to
3 days from now with the

Private Const C_NUM_DAYS_UNTIL_EXPIRATION = 3


Gord

Hi Gord

OK thanks. I tried it out - very interesting.

When I run it , with 3 days as the target , I get a value of 39360 for
'Expiration Date' (!)

I substituted 39450 for this , and sure enough the pop-up appeared to
tell me it had expired.

I'm not sure what number , in terms of days , 39360 represents. Maybe my
number 3 in Private Const C_NUM_DAYS_UNTIL_EXPIRATION = 3 should be 03 ,
or 3.0.....

I tried changing the system clock a few times to get 39360 to time out ,
but couldn't manage it. It's clearly at the centre of the failure at
this end , because it had properly registered Expiration Date , and
39450 does give the desired effect. Is it the number format causing the
problem , do you think?

Also , by not saving the wb manually , would the date not register , or
is it built into the routine to store it anyway? Maybe a save could be
built in to force this - otherwise I could see it not working...

^_^

Best Wishes


Colin






Gord Dibben said:
Works for me Colin.

What value do you see for "Expiration Date" and "Refers to" in
Insert>Name>Define after running the macro

Sub foo()
For Each Name In ThisWorkbook.Names
Name.Visible = True
Next
End Sub

I see =39453 which is 3 days from now.

Change that to 39450, save and re-open.

You should get the warning message that the trial has expired. Click OK and the
workbook closes.


Gord
Click to expand...
wrote:


Hi Gord

I'm finding this isn't working , I'm afraid.

It doesn't give an error - it just doesn't come into effect after the
expiry time. I wonder if you'd mind casting your eye over , to see if
you can a problem/

I've put this macro in my workbook , it's called 'TB' :



Private Const C_NUM_DAYS_UNTIL_EXPIRATION = 3

'change number above for amount of days until expiry

'Making The Code Run At Open. ( It will not work if you don't do this!)

' Call the procedure for the Workbook_Open event procedure
' in the ThisWorkbook code module under the excel icon top left.

'Private Sub Workbook_Open()
' TB
'End Sub


Sub TB()
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' TB
' This procedure uses a defined name to store this workbook's
' expiration date. If the expiration date has passed, a
' MsgBox is displayed and this workbook is closed.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim ExpirationDate As String
Dim NameExists As Boolean

On Error Resume Next
ExpirationDate = Mid(ThisWorkbook.Names("ExpirationDate").Value, 2)
If Err.Number <> 0 Then
'''''''''''''''''''''''''''''''''''''''''''
' Name doesn't exist. Create it.
'''''''''''''''''''''''''''''''''''''''''''
NameExists = False
ExpirationDate = CStr(DateSerial(Year(Now), _
Month(Now), Day(Now) + C_NUM_DAYS_UNTIL_EXPIRATION))
ThisWorkbook.Names.Add Name:="ExpirationDate", _
RefersTo:=Format(ExpirationDate, "short date"), _
Visible:=False
Else
NameExists = True
End If

''''''''''''''''''''''''''''''''''''''''''''''''''''''
' If the today is past the expiration date, close the
' workbook. If the defined name didn't exist, we need
' to Save the workbook to save the newly created name.
''''''''''''''''''''''''''''''''''''''''''''''''''''''
If CDate(Now) > CDate(ExpirationDate) Then
MsgBox "Your trial period has now expired.", vbOKOnly
ThisWorkbook.Close savechanges:=False
End If

End Sub


I've put this code into the code under the excel icon top left of the
screen

Private Sub Workbook_Open()
TB
End Sub



I can't see why it doesn't work , but it's going way beyond the close
date of 3 days...

I do notice that when I go to close the wb , it does ask if I want to
save any changes - if I click 'No' , does this mean that the time stamp
isn't saved?

Any help gratefully received.



Best Wishes


Colin











Correct on that score.

If the workbook_open code doesn't run the macro then nothing will happen.

Protecting the code from prying eyes is essential.

With the workbook open go to the VB Editor and right-click on your
workbook/project and select VBAProject Prperties>Protection>Lock Project fro
Viewing.

Enter a password then save and close before protection takes place.

If the user makes a copy of the original workbook before opening it then I guess
he will have a clean original handy to start over again when the copy times out.

You can't stop them from thwarting your goals<g>

If it is that important and you need the security you should look at Chip's
suggestions for creating a Com add-in.

Don't forget that you will also need to ensure that your workbook won't be
usable if user decides to disable macros upon opening the workbook for the first
time.

Chip also shows you how to do that by hiding sheets in a BeforeClose event.

That event would have to be run when you save/close the workbook before
distribution.

Two more sets of code to add.......one to the workbook_open event and a new
one
for beforeclose event.

All info and code on Chip's site. Read the "Introduction" carefully and note
the link to "Ensure Macros are Enabled"

Getting easier all the time, eh?


Gord


On Sun, 2 Dec 2007 01:48:26 +0000, Colin Hayes
<[email protected]>
wrote:



Hi Gord

Thanks again for your help.

For the sake of simplicity , I'll keep two versions of my wb - one with
the limitation and one without. I'll do any development work on one and
only add the routines below once it's ready to go. I'll save it then in
a different name , so I always keep the development one unrestricted for
my own purposes.

I assume , in any case , that I can have the macro always in place in
the wb , and it will only be activated when I put the code into the
Thisworkbook module. In that way , I can do development work and only
place the code in the Thisworkbook module as the final thing when it's
ready to go.

Not sure what you mean by protecting the project under VBA Project
Properties.

I take your point that it's not foolproof security by any means , and
can be circumvented , but I do think it will be enough for my purposes.

(As a thought though - once the 30 day trial is over , and the wb is no
longer accessible , what is to stop the user simply reinstalling the
original file over the top of the existing one and having another 30
days?)


^_^


Colin


To get rid of the hidden name "Expiration Date" you could run this macro.

Sub foo()
For Each Name In ThisWorkbook.Names
Name.Visible = True
Next
End Sub

Now go to Insert>Name>Define and delete the name which you will see refers
to
the expiry date.

Save the workbook which is now ready for the name to be re-created when
you
next open it.

If user is sophisticated enough he will be able to run a similar macro and
change the date from 90 days to 9000 days but if he is that savvy then he will
have defeated your original code anyway.

If by "locked out" you mean you have already made the workbook read- only,
disabling macros will not change the read-only property.

Just save as a copy of the original after deleting the name then disable
macros
if you want to do more editing of code. You may have to do this several times
before you final copy is ready.

When ready for distribution make sure you have deleted the name and
protected
the project under VBA Project Properties.


Gord


On Sat, 1 Dec 2007 22:47:18 +0000, Colin Hayes
<[email protected]>
wrote:



Hi Gord

OK Thanks for that. I've put it all in place and all seems well.

I do note from the article on cpearson.com that he says :

'This procedure, TimeBombWithDefinedName, uses a hidden defined name
to
store the expiration date. The first time the workbook is opened, that
defined name will not exist and will be created by the code. **(Be sure
that you delete this name when you are done with your own development
work on the workbook.)'**

I'm not clear as to how I would go about deleting the hidden defined
name , or where I would find it.

Or should I just replace all references to 'Expiration Date' with some
other term and let it start again?

I assume also that if I were to lock myself out during development , I
could re-open the wb by disabling macros in excel. Would that work?


Thanks Gord for your help.





Thisworkbook module is accessed under the Excel Icon left of "File" on the
Menu
Bar after Right-click and "View Code".

On third thought, the msgbox should p[robably be wrapped inside the "If"
statement

ThisWorkbook.ChangeFileAccess xlReadOnly
MsgBox "This workbook has become readonly"
End If
End Sub

The stored value is in each workbook and is not common to all.

The stored value does not get overwritten after the first opening of the
workbook.

The name "Expiration Date" holding the start date is created and if it
exists,
it is not re-created.

Keep reading Chip's instructions to get an idea of how all this works.


Gord

On Sat, 1 Dec 2007 14:08:33 +0000, Colin Hayes
<[email protected]>
wrote:


Hi Gord

OK Thanks for that.

Is the 'Workbook_Open event procedure in the ThisWorkbook code
module'
under the first tab on the worksheet , or under the Excel symbol top
left of the screen? I always confuse those. I'll put the code to run the
macro there.

Also , if I have the code in several different workbooks , will the
routine not over-write it's stored values , or is each record kept
separately for each wb when the code is in place?

Thanks again Gord
Click to expand...
Click to expand...
Click to expand...
 
Colin

I create a new workbook, paste the TB macro code into a general module exactly
as you have posted.

Paste the workbook_open code to Thisworkbook module......removed the
Comments(').

Saved the workbook. Closed and reopened. Ran Sub foo()

Insert>Name>Define "ExpirationDate" refers to is 39481 which equates to
February 03, 2008..............30 days from today.

Nothing wrong with Chip's code as far as I can see through testing.

Could be your Regional and Language Settings are different from mine which are
English(US)

Maybe you can send me the workbook through email.......strip any password
protection if any but leave all else as is.

Change the AT and DOT to get my email address.


Gord

Hi Gord

Thanks for your patience with this one. I tried this out on another
machine with identical results. I then tried varying the number of days
contained in Private Const C_NUM_DAYS_UNTIL_EXPIRATION

These were the results :

1 = 39569
3 = 39630
5 = 39692
10 = "14/01/2008"
15 = "19/01/2008"
20 = "24/01/2008"
25 = "29/01/2008"
30 = 39509
35 = 39662
50 = "23/02/2008"

I'm really surprised at these. I don't know why they would be given in
different formats. It makes me think that the date coding in the macro
is wrong somehow. It seems that the results which give full dates with
speech marks are all correct (given the system date of 04/01/2008) , but
all the numerical results are wrong. I looked at the Chip Pearson site ,
and it seems none of the numerical results equate correctly , and
wouldn't work.

This is the macro exactly as I'm running it :



Private Const C_NUM_DAYS_UNTIL_EXPIRATION = 30

'change number above for amount of days until expiry

'Making The Code Run At Open. ( It will not work if you don't do this!)

' Call the procedure for the Workbook_Open event procedure
' in the ThisWorkbook code module under the excel icon top left.

'Private Sub Workbook_Open()
' TB
'End Sub


Sub TB()
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' TB
' This procedure uses a defined name to store this workbook's
' expiration date. If the expiration date has passed, a
' MsgBox is displayed and this workbook is closed.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim ExpirationDate As String
Dim NameExists As Boolean

On Error Resume Next
ExpirationDate = Mid(ThisWorkbook.Names("ExpirationDate").Value, 2)
If Err.Number <> 0 Then
'''''''''''''''''''''''''''''''''''''''''''
' Name doesn't exist. Create it.
'''''''''''''''''''''''''''''''''''''''''''
NameExists = False
ExpirationDate = CStr(DateSerial(Year(Now), _
Month(Now), Day(Now) + C_NUM_DAYS_UNTIL_EXPIRATION))
ThisWorkbook.Names.Add Name:="ExpirationDate", _
RefersTo:=Format(ExpirationDate, "short date"), _
Visible:=False
Else
NameExists = True
End If

''''''''''''''''''''''''''''''''''''''''''''''''''''''
' If the today is past the expiration date, close the
' workbook. If the defined name didn't exist, we need
' to Save the workbook to save the newly created name.
''''''''''''''''''''''''''''''''''''''''''''''''''''''
If CDate(Now) > CDate(ExpirationDate) Then
MsgBox "Your trial period has now expired.", vbOKOnly
ThisWorkbook.Close savechanges:=False
End If

End Sub


Can you see any error in here?
Click to expand...
<snipped>
 
HI Gord

OK thanks.

I tried again , and am consistently getting 39509 for 30 days. This
happens on both my machines. For 3 days , it gives a higher number of
39630 which clearly can't be right.

I send my sample file to you. As you say , it may be different settings
causing it . Hmmm.

In my file , I've called the main macro TB , and the foo macro TB_see


Best Wishes


Colin
 
Colin Hayes said:
I send my sample file to you. As you say , it may be different
settings causing it . Hmmm.
Click to expand...
....

Your regional settings are the problem. Define your ExpirationDate by
setting the RefersToLocal property rather than the RefersTo property.

The latter **ALWAYS** interprets text representations of dates using
standard US date formatting, e.g., mm/dd/yyyy.
 
Received and all OK at my end. Have sent reply.

For others who may be watching...........

The inconsistencies Colin is getting is because his Regional and Language
Settings short date format is dd/mm/yyyy while the code assumes a mm/dd/yyyy
setting per North American standards.

That is the source of the 39509 and 39630 serials.

The line RefersTo:=Format(ExpirationDate, "short date") uses the short date
format from Regional Options.


Gord
 
...

Your regional settings are the problem. Define your ExpirationDate by
setting the RefersToLocal property rather than the RefersTo property.

The latter **ALWAYS** interprets text representations of dates using
standard US date formatting, e.g., mm/dd/yyyy.
Click to expand...

Hi

Yes , the regional settings issue is a problem. Would the re-defining of
the ExpirationDate value solve this? Hope so. The macro needs to work on
whichever machine it's installed on , whatever the settings. I
appreciate it's not impregnable security , but it would suffice for the
purpose I have in mind.

Would the code be modified to accommodate your suggestion in this way?

NameExists = False
ExpirationDate = CStr(DateSerial(Year(Now), _
Month(Now), Day(Now) + C_NUM_DAYS_UNTIL_EXPIRATION))
ThisWorkbook.Names.Add Name:="ExpirationDate", _
RefersToLocal:=Format(ExpirationDate, "short date"), _
Visible:=False

thanks again.

BTW Do the date numbers generated using the English (US) regional
setting just increment by one daily?

Those generated for the UK settings seems to be entirely without logic
or predictable format..


Best Wishes


Colin
 
Colin Hayes said:
....
Yes , the regional settings issue is a problem. Would the
re-defining of the ExpirationDate value solve this? Hope so. The
macro needs to work on whichever machine it's installed on ,
whatever the settings. . . . ....
Would the code be modified to accommodate your suggestion in this
way?

NameExists = False
ExpirationDate = CStr(DateSerial(Year(Now), _
Month(Now), Day(Now) + C_NUM_DAYS_UNTIL_EXPIRATION))
ThisWorkbook.Names.Add Name:="ExpirationDate", _
RefersToLocal:=Format(ExpirationDate, "short date"), _
Visible:=False
Click to expand...

Maybe, but there's a better way. Simply put, DON'T USE SHORT DATE
FORMAT. Use ISO yyyy-mm-dd date format. It's **ALWAYS** interpreted
correctly.
BTW Do the date numbers generated using the English (US) regional
setting just increment by one daily?

Those generated for the UK settings seems to be entirely without
logic or predictable format..
Click to expand...

Date numbers are the number of days from 31-Dec-1899 for dates on or
after 1-Mar-1900, the number of days from 1-Jan-1900 for dates between
1-Jan-1900 and 28-Feb-1900, and date number 60 corresponds to the
erroneous 29-Feb-1900, a Lotus screw up that Microsoft believed it had
to copy.

There is *NO* difference in how date NUMBERS work in any regional
settings. There's only differences in how the date string to date
number conversion works. Again, the Name class's RefersTo property
ALWAYS assumes US regional settings, so dates are ALWAYS interpreted
as mm/dd/yyyy. If you set a Name's RefersTo property to "09/01/2008",
Excel will ALWAYS convert that to the date number for 1-Sep-2008.
However, if you set RefersTo to "15/01/2008", Excel will first try to
convert it to a date, see that it's not a valid date IN US REGIONAL
SETTINGS, and therefore leave it unchanged as a text string. If your
regional settings use the dd/mm/yyyy date format, then setting the
RefersToLocal property to "09/01/2008" or "15/01/2008" will convert
them to 9-Jan-2008 or 15-Jan-2008, respectively.

So a simple lesson for everyone living outside the US - NEVER USE THE
RefersTo PROPERTY OF NAME OBJECTS - **ALWAYS** USE THE RefersToLocal
PROPERTY INSTEAD. Make this a habit.

Anyway, you could replace the code above with

ThisWorkbook.Names.Add Name:="ExpirationDate", Visible:=False, _
RefersToLocal:=Int(Now) + C_NUM_DAYS_UNTIL_EXPIRATION + 1,

I can't see any purpose served by setting the NameExists variable.

Note: adding 1 to this value means someone opening this file for the
first time, say, 3 minutes before midnight gets a 3 day and 3 minute
trial period. Without doing this, they'd get a 2 day and 3 minute
trial. Unless you really want to annoy your customers, always round
partial days in their favor.
 
Back
Top