Code for "program evaluation period"?
 

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

Code for "program evaluation period"?
 

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

Code for "program evaluation period"?
 

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

Code for "program evaluation period"?
 

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

Code for "program evaluation period"?
 

As another thing, type this in the VBA immediate window when that file is
open, and see what you get

?Evaluate(ThisWorkbook.Names("__ExpiryDate").Refer sTo)

--
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

Code for "program evaluation period"?
 

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

Code for "program evaluation period"?
 

Answer = 39100 ..if that makes any sense..

Phil


"Bob Phillips" wrote in message
...
As another thing, type this in the VBA immediate window when that file is
open, and see what you get

?Evaluate(ThisWorkbook.Names("__ExpiryDate").Refer sTo)

--
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

Code for "program evaluation period"?
 

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 C" wrote in message
...
Answer = 39100 ..if that makes any sense..

Phil


"Bob Phillips" wrote in message
...
As another thing, type this in the VBA immediate window when that file
is
open, and see what you get

?Evaluate(ThisWorkbook.Names("__ExpiryDate").Refer sTo)

--
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

Code for "program evaluation period"?
 

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)

"Bob Phillips" wrote in message
...
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 C" wrote in message
...
Answer = 39100 ..if that makes any sense..

Phil


"Bob Phillips" wrote in message
...
As another thing, type this in the VBA immediate window when that file
is
open, and see what you get

?Evaluate(ThisWorkbook.Names("__ExpiryDate").Refer sTo)

--
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

Code for "program evaluation period"?
 

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

"Bob Phillips" wrote in message
...
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 C" wrote in message
...
Answer = 39100 ..if that makes any sense..

Phil


"Bob Phillips" wrote in message
...
As another thing, type this in the VBA immediate window when that
file
is
open, and see what you get

?Evaluate(ThisWorkbook.Names("__ExpiryDate").Refer sTo)

--
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

Code for "program evaluation period"?
 

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").Refer sTo)
.... 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



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

"Bob Phillips" wrote in message
...
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 C" wrote in message
...
Answer = 39100 ..if that makes any sense..

Phil


"Bob Phillips" wrote in message
...
As another thing, type this in the VBA immediate window when that
file
is
open, and see what you get

?Evaluate(ThisWorkbook.Names("__ExpiryDate").Refer sTo)

--
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