Thanks Bob, you're a star.

Phil


"Bob Phillips" wrote in message
...
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)

"Phil C" wrote in message
...
Hi Bob

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

Phil



"Bob Phillips" wrote in message
...
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)

"Phil C" wrote in message
...
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