Code for "program evaluation period"?

[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

[Bob Phillips]

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" <phil.cosgriff@ulh.nhs.uk> wrote in message
news:eduKqyTXGHA.1192@TK2MSFTNGP03.phx.gbl...
> 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 C]

Hi Bob

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

Phil



"Bob Phillips" <bob.phillips@notheretiscali.co.uk> wrote in message
news:ehvI9EUXGHA.3448@TK2MSFTNGP03.phx.gbl...
> 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" <phil.cosgriff@ulh.nhs.uk> wrote in message
> news:eduKqyTXGHA.1192@TK2MSFTNGP03.phx.gbl...
> > 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
> >
> >
>
>

[Bob Phillips]

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" <phil.cosgriff@ulh.nhs.uk> wrote in message
news:%23ti%23zQYXGHA.1196@TK2MSFTNGP03.phx.gbl...
> Hi Bob
>
> Yes, I created an "evaluation period = 1 day" version last Friday (4 days
> ago) and it still runs..
>
> Phil
>
>
>
> "Bob Phillips" <bob.phillips@notheretiscali.co.uk> wrote in message
> news:ehvI9EUXGHA.3448@TK2MSFTNGP03.phx.gbl...
> > 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" <phil.cosgriff@ulh.nhs.uk> wrote in message
> > news:eduKqyTXGHA.1192@TK2MSFTNGP03.phx.gbl...
> > > 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
> > >
> > >
> >
> >
>
>

[Bob Phillips]

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)

"Phil C" <phil.cosgriff@ulh.nhs.uk> wrote in message
news:%23ti%23zQYXGHA.1196@TK2MSFTNGP03.phx.gbl...
> Hi Bob
>
> Yes, I created an "evaluation period = 1 day" version last Friday (4 days
> ago) and it still runs..
>
> Phil
>
>
>
> "Bob Phillips" <bob.phillips@notheretiscali.co.uk> wrote in message
> news:ehvI9EUXGHA.3448@TK2MSFTNGP03.phx.gbl...
> > 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" <phil.cosgriff@ulh.nhs.uk> wrote in message
> > news:eduKqyTXGHA.1192@TK2MSFTNGP03.phx.gbl...
> > > 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 C]

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

Phil


"Bob Phillips" <bob.phillips@notheretiscali.co.uk> wrote in message
news:eJrstfYXGHA.3936@TK2MSFTNGP05.phx.gbl...
> 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)
>
> "Phil C" <phil.cosgriff@ulh.nhs.uk> wrote in message
> news:%23ti%23zQYXGHA.1196@TK2MSFTNGP03.phx.gbl...
> > Hi Bob
> >
> > Yes, I created an "evaluation period = 1 day" version last Friday (4
days
> > ago) and it still runs..
> >
> > Phil
> >
> >
> >
> > "Bob Phillips" <bob.phillips@notheretiscali.co.uk> wrote in message
> > news:ehvI9EUXGHA.3448@TK2MSFTNGP03.phx.gbl...
> > > 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" <phil.cosgriff@ulh.nhs.uk> wrote in message
> > > news:eduKqyTXGHA.1192@TK2MSFTNGP03.phx.gbl...
> > > > 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 C]

Thanks Bob, you're a star.

Phil


"Bob Phillips" <bob.phillips@notheretiscali.co.uk> wrote in message
news:eKXKJcYXGHA.3532@TK2MSFTNGP05.phx.gbl...
> 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" <phil.cosgriff@ulh.nhs.uk> wrote in message
> news:%23ti%23zQYXGHA.1196@TK2MSFTNGP03.phx.gbl...
> > Hi Bob
> >
> > Yes, I created an "evaluation period = 1 day" version last Friday (4
days
> > ago) and it still runs..
> >
> > Phil
> >
> >
> >
> > "Bob Phillips" <bob.phillips@notheretiscali.co.uk> wrote in message
> > news:ehvI9EUXGHA.3448@TK2MSFTNGP03.phx.gbl...
> > > 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" <phil.cosgriff@ulh.nhs.uk> wrote in message
> > > news:eduKqyTXGHA.1192@TK2MSFTNGP03.phx.gbl...
> > > > 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
> > > >
> > > >
> > >
> > >
> >
> >
>
>

[Bob Phillips]

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" <phil.cosgriff@ulh.nhs.uk> wrote in message
news:uI0JisgXGHA.3684@TK2MSFTNGP05.phx.gbl...
> Answer = 39100 ..if that makes any sense..
>
> Phil
>
>
> "Bob Phillips" <bob.phillips@notheretiscali.co.uk> wrote in message
> news:eJrstfYXGHA.3936@TK2MSFTNGP05.phx.gbl...
> > 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)
> >
> > "Phil C" <phil.cosgriff@ulh.nhs.uk> wrote in message
> > news:%23ti%23zQYXGHA.1196@TK2MSFTNGP03.phx.gbl...
> > > Hi Bob
> > >
> > > Yes, I created an "evaluation period = 1 day" version last Friday (4
> days
> > > ago) and it still runs..
> > >
> > > Phil
> > >
> > >
> > >
> > > "Bob Phillips" <bob.phillips@notheretiscali.co.uk> wrote in message
> > > news:ehvI9EUXGHA.3448@TK2MSFTNGP03.phx.gbl...
> > > > 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" <phil.cosgriff@ulh.nhs.uk> wrote in message
> > > > news:eduKqyTXGHA.1192@TK2MSFTNGP03.phx.gbl...
> > > > > 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
> > > > >
> > > > >
> > > >
> > > >
> > >
> > >
> >
> >
>
>

[Bob Phillips]

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" <bob.phillips@notheretiscali.co.uk> wrote in message
news:ug93SXhXGHA.3660@TK2MSFTNGP04.phx.gbl...
> 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" <phil.cosgriff@ulh.nhs.uk> wrote in message
> news:uI0JisgXGHA.3684@TK2MSFTNGP05.phx.gbl...
> > Answer = 39100 ..if that makes any sense..
> >
> > Phil
> >
> >
> > "Bob Phillips" <bob.phillips@notheretiscali.co.uk> wrote in message
> > news:eJrstfYXGHA.3936@TK2MSFTNGP05.phx.gbl...
> > > 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)
> > >
> > > "Phil C" <phil.cosgriff@ulh.nhs.uk> wrote in message
> > > news:%23ti%23zQYXGHA.1196@TK2MSFTNGP03.phx.gbl...
> > > > Hi Bob
> > > >
> > > > Yes, I created an "evaluation period = 1 day" version last Friday (4
> > days
> > > > ago) and it still runs..
> > > >
> > > > Phil
> > > >
> > > >
> > > >
> > > > "Bob Phillips" <bob.phillips@notheretiscali.co.uk> wrote in message
> > > > news:ehvI9EUXGHA.3448@TK2MSFTNGP03.phx.gbl...
> > > > > 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" <phil.cosgriff@ulh.nhs.uk> wrote in message
> > > > > news:eduKqyTXGHA.1192@TK2MSFTNGP03.phx.gbl...
> > > > > > 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 C]

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" <bob.phillips@notheretiscali.co.uk> wrote in message
news:OHjBO1lYGHA.3848@TK2MSFTNGP05.phx.gbl...
> 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" <bob.phillips@notheretiscali.co.uk> wrote in message
> news:ug93SXhXGHA.3660@TK2MSFTNGP04.phx.gbl...
> > 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" <phil.cosgriff@ulh.nhs.uk> wrote in message
> > news:uI0JisgXGHA.3684@TK2MSFTNGP05.phx.gbl...
> > > Answer = 39100 ..if that makes any sense..
> > >
> > > Phil
> > >
> > >
> > > "Bob Phillips" <bob.phillips@notheretiscali.co.uk> wrote in message
> > > news:eJrstfYXGHA.3936@TK2MSFTNGP05.phx.gbl...
> > > > 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)
> > > >
> > > > "Phil C" <phil.cosgriff@ulh.nhs.uk> wrote in message
> > > > news:%23ti%23zQYXGHA.1196@TK2MSFTNGP03.phx.gbl...
> > > > > Hi Bob
> > > > >
> > > > > Yes, I created an "evaluation period = 1 day" version last Friday
(4
> > > days
> > > > > ago) and it still runs..
> > > > >
> > > > > Phil
> > > > >
> > > > >
> > > > >
> > > > > "Bob Phillips" <bob.phillips@notheretiscali.co.uk> wrote in
message
> > > > > news:ehvI9EUXGHA.3448@TK2MSFTNGP03.phx.gbl...
> > > > > > 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" <phil.cosgriff@ulh.nhs.uk> wrote in message
> > > > > > news:eduKqyTXGHA.1192@TK2MSFTNGP03.phx.gbl...
> > > > > > > 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 C]

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



"Bob Phillips" <bob.phillips@notheretiscali.co.uk> wrote in message
news:OHjBO1lYGHA.3848@TK2MSFTNGP05.phx.gbl...
> 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" <bob.phillips@notheretiscali.co.uk> wrote in message
> news:ug93SXhXGHA.3660@TK2MSFTNGP04.phx.gbl...
> > 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" <phil.cosgriff@ulh.nhs.uk> wrote in message
> > news:uI0JisgXGHA.3684@TK2MSFTNGP05.phx.gbl...
> > > Answer = 39100 ..if that makes any sense..
> > >
> > > Phil
> > >
> > >
> > > "Bob Phillips" <bob.phillips@notheretiscali.co.uk> wrote in message
> > > news:eJrstfYXGHA.3936@TK2MSFTNGP05.phx.gbl...
> > > > 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)
> > > >
> > > > "Phil C" <phil.cosgriff@ulh.nhs.uk> wrote in message
> > > > news:%23ti%23zQYXGHA.1196@TK2MSFTNGP03.phx.gbl...
> > > > > Hi Bob
> > > > >
> > > > > Yes, I created an "evaluation period = 1 day" version last Friday
(4
> > > days
> > > > > ago) and it still runs..
> > > > >
> > > > > Phil
> > > > >
> > > > >
> > > > >
> > > > > "Bob Phillips" <bob.phillips@notheretiscali.co.uk> wrote in
message
> > > > > news:ehvI9EUXGHA.3448@TK2MSFTNGP03.phx.gbl...
> > > > > > 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" <phil.cosgriff@ulh.nhs.uk> wrote in message
> > > > > > news:eduKqyTXGHA.1192@TK2MSFTNGP03.phx.gbl...
> > > > > > > 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
> > > > > > >
> > > > > > >
> > > > > >
> > > > > >
> > > > >
> > > > >
> > > >
> > > >
> > >
> > >
> >
> >
>
>