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)

"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

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

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

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

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

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

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