Code for "program evaluation period"?

  • Thread starter Thread starter Phil C
  • Start date Start date
P

Phil C

Hi Guys

Could someone please tell me what is wrong with the following (placed in
ThisWorkbook)?
I got the basic code from Bob Phillips via this NG, which worked fine. It
just stopped (closed imediately) after x days (with no message to user)
All I have done is to set the trial.period to 1 day (for test purposes) and
added a few lines of message text using Msg.
Now the excel spreadsheet in question (Excel 2000) runs on beyond the trial
period...
I have also tried reducing the message box to 1 line (and other irrational
things) but can no longer persude it to close!
Any ideas?

Thanks for your help

Phil

***************

Private Sub Workbook_Open()
Const sEDName As String = "__ExpiryDate"
Const nEvalPeriod As Long = 1
Dim ExpiryDate As Date
Dim sDate As String
Dim Msg As String

On Error Resume Next
ExpiryDate = Evaluate(ThisWorkbook.Names(sEDName).RefersTo)
On Error GoTo 0

If ExpiryDate = 0 Then
ThisWorkbook.Names.Add Name:=sEDName, _
RefersTo:=Date + nEvalPeriod
ThisWorkbook.Names(sEDName).Visible = False
ThisWorkbook.Save
Else
If ExpiryDate < Date Then
Msg = "The trial period has been exceeded." & vbCrLf
Msg = Msg & "If you wish to continue using, purchase the
program via the website:" & vbCrLf
Msg = Msg & "website.com" & vbCrLf
MsgBox Msg
ThisWorkbook.Close savechanges:=False
End If
End If

End Sub
 
Phil,

It actually allows 2 days because you are testing ExpiryDate < Date. Have
you just not waited long enough?

--
HTH

Bob Phillips

(remove nothere from email address if mailing direct)
 
Hi Bob

Yes, I created an "evaluation period = 1 day" version last Friday (4 days
ago) and it still runs..

Phil
 
Phil,

I will create a workbook now with that code and see what happens tomorrow,
then on Thu. Check back on Thu for a follow-up post by me.

--
HTH

Bob Phillips

(remove nothere from email address if mailing direct)
 
As another thing, type this in the VBA immediate window when that file is
open, and see what you get

?Evaluate(ThisWorkbook.Names("__ExpiryDate").RefersTo)

--
HTH

Bob Phillips

(remove nothere from email address if mailing direct)
 
Thanks Bob, you're a star.

Phil


Bob Phillips said:
Phil,

I will create a workbook now with that code and see what happens tomorrow,
then on Thu. Check back on Thu for a follow-up post by me.

--
HTH

Bob Phillips

(remove nothere from email address if mailing direct)

(placed
Click to expand...
 
Therein lies the problem Phil. 39100 is 18th Jan 2007, so it won't expire
for another 8 months. How did it get to that value?

I suggest typing this in the immediate window, and starting again, save the
workbook, re-open it, and check Friday..

activeworkbook.Names("__ExpiryDate").delete

I will re-post my results tomorrow

--
HTH

Bob Phillips

(remove nothere from email address if mailing direct)
 
Phil,

Sorry I forgot to post last week, but I just tried it and it works exactly
as expected.

Did you see my previous response?

--
HTH

Bob Phillips

(remove nothere from email address if mailing direct)
 
Hi Bob

Hmmm. Bit of a dead end? My version(s) still don't work. Or rather, they do
work (beyond the intended expiry).
Could you re-send (or re-post) the code (including the multiple message
[msg] lines, which display a message to the user prior to the program
closing) and I will have one more go at re-creating.

Many thanks

Phil
 
Bob

With my system, the expiry date seems to have to be "initialised" within the
macro using the code you suggested for the immediate window.
I have thus inserted the following line after the DIM statements.

activeworkbook.Names("__ExpiryDate").delete

Using the code ... ?Evaluate(ThisWorkbook.Names("__ExpiryDate").RefersTo)
.... in the Immediate window, programs that were not working all had
indicated expiry dates of January 07 (!). I modified one of these today (as
indicated above, with an intended expiry period of 1 day) and, after
re-saving, the program now indicates an expiry of tomorrow (19 April) ..
which sounds promising. Why I should have to 'reset' the date in this way
(and you apparently don't) is a mystery. I have even tried running the
programs on a different (brand new) computer running Windows XP/Excel 2003
(as opposed to Windows 2000/Excel 2000), and the expiry dates still indicate
Jan 07 unless I do as above..

Still, if it works..

Phil
 
Back
Top