is it possible to set a work book to stop working after say 2 weeks

[Paul Betts]

The problem I have is I need to send out work books, but after say 2 weeks I
need them to stop working.

The peeps will down load the file, so it would be nice if there is a macro
or sum that will activate the time when the file is down loaded.

I can make the file only work for 2 weeks when the file is opened with the
"=now()" which sets the date the file will run from, but on downloading the
file it is saved, so they can save the file as many times as they like
before opening and it is only when each file is opened that the time starts.

Hopefully I have made this clear what I am after? (like mud)

Thanks for any help

Paul.

[Chip Pearson]

Paul,

There is fool-proof way to do this. Here's some code that will protect
against typical users, but not determined users.

Sub Auto_Open()
Dim WS As Worksheet
If NameExists("StartDate") = True Then
If Now - LongFromName("StartDate") > 14 Then
'
' disable your command buttons, or make the file read only, or
' do something.
'
On Error Resume Next
For Each WS In ThisWorkbook.Worksheets
WS.UsedRange.Locked = True
WS.Protect password:="Password"
Next WS
Application.DisplayAlerts = False
ThisWorkbook.Protect password:="Password"
ThisWorkbook.ChangeFileAccess xlReadOnly
Application.DisplayAlerts = True
End If
Else
ThisWorkbook.Names.Add Name:="StartDate", RefersTo:=Format(Now,
"00000"), Visible:=False
End If

End Sub
Function LongFromName(S As String) As Long
LongFromName = CLng(Mid(ThisWorkbook.Names(S).RefersTo, 2))
End Function
Function NameExists(S As String) As Boolean
On Error Resume Next
NameExists = Len(ThisWorkbook.Names(S).Name) <> 0
End Function

--
Cordially,
Chip Pearson
Microsoft MVP - Excel
Pearson Software Consulting, LLC
www.cpearson.com ch...@cpearson.com

"Paul Betts" <be...@betts11.fsnet.co.uk> wrote in message
news:99sqkg$8qd$1...@news5.svr.pol.co.uk...

[Paul Betts]

Oh, this looks good, and very complicated for me, never the less I will give
this ago, it looks as if it should do the trick.

Thank very much

Paul

"Chip Pearson" <ch...@cpearson.com> wrote in message
news:ejmCtH5tAHA.2156@tkmsftngp05...

[mark....@virgin.net]

Hiya Paul

This code below isn't set up for a time period but for a specified
number of openings of the file. The guts of it were kindly supplied
to me by Robert Umlas at All Experts
http://www.allexperts.com/getExpert.asp?Category=1059
I hope that it helps.

The Sub below needs to be put in the "This Workbook" page in the
"Microsoft Excel Objects" Folder in the VBAProject

Private Sub Workbook_Open()

'Below is the Password for Non-Cheaters! - Done automatically if
'Workbook is NOT opened by holding down the "Shift"
'Button which would then bypass this Workbook_Open Code.

ThisWorkbook.Unprotect "PasswordName"

'Visible file for Non-Cheaters! - Automatic.
ThisWorkbook.Windows(1).Visible = True

'Remove this line below if protection is no longer needed

Call UpdateCantRun 'Trial Period Sub Call

End Sub

'Enter all code below into a seperate module in the VBAProject

Function CantRun() As Boolean
If val(GetSetting("TrialLimit", "NumRuns", "NumRuns", "20")) < 1
Then CantRun = True
End Function

Sub UpdateCantRun()
'This Sub is designed to allow only (in this case) 20 openings
'of the Workbook. This is only applicable when the Project is
'being trialled by a third party.

Dim x As Integer
Dim msg As String

Application.Workbooks.Application.Visible = False

On Err GoTo GetOut

x = val(GetSetting("TrialLimit", "NumRuns", "NumRuns", "20"))
SaveSetting "TrialLimit", "NumRuns", "NumRuns", x - 1

If x >= 1 Then
If x > 2 Then
msg = "You are now able to open this Project a further "
msg = msg & CStr(x - 1)
msg = msg & " times only."
ElseIf x = 2 Then
msg = "You are now able to open this Project a further "
msg = msg & "once only."
ElseIf x = 1 Then
msg = "This is the last time that you may open this Project _
during your trial period. "
msg = msg & "I hope that you found this Project useful"
msg = msg & " and wish to purchase it for further use."
End If

MsgBox (msg)

ElseIf CantRun Then
msg = "Your evaluation period has ended - "
msg = msg & "I hope that you found this Project useful"
msg = msg & " and wish to purchase it for further use."
MsgBox (msg)

Application.Quit
End If

GetOut: If Err <> 0 Then
Application.Quit
End If

Application.Workbooks.Application.Visible = True

End Sub

Sub ResetCantRun()
'This Sub resets the counter value 'x' for the trial period.
On Error Resume Next
DeleteSetting "TrialLimit", "NumRuns", "NumRuns"
End Sub

-------------

PS - Don't forget to password protect your VBA Code using Tools -> VBA
Project Properties -> Protection Tab and Click Check Box.

--

[mark....@virgin.net]

Hiya Paul (again!)>

Apologies but you will also need the sub below - again it too needs to

be put in the "This Workbook" page in the "Microsoft Excel Objects"

Folder in the VBAProject:

@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@

Private Sub Workbook_BeforeClose(Cancel As Boolean)

'This code hides the Workbook before closing it and sets a password
'so that if the user attempts to bypass the Workbook_Open sub with
' its associated trial counter by pressing the 'SHIFT' button then a
'password must be entered before the wordbook can be 'Unhidden'.
'If no by-pass is attempted then the password is included in the code
'of the Workbook_Open sub and is activated automatically.

ThisWorkbook.Windows(1).Visible = False

'Set up for possible Cheaters!
ThisWorkbook.Protect Password:="PasswordName", Structure:=True, _
Windows:=True 'Set up for possible Cheaters!

End Sub

@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@

--

[Paul Betts]

Hi
I have been working on the code you done, but I have problems with sorting
the small part I have to put in, as follows:

Else
ThisWorkbook.Names.Add Name:="StartDate", RefersTo:=Format(Now,
"00000"), Visible:=False
End If

Can u help on this ???

Many thanks again

Paul Betts

"Chip Pearson" <ch...@cpearson.com> wrote in message
news:ejmCtH5tAHA.2156@tkmsftngp05...

[Paul Betts]

The work book I am messing around with at moment is "workbook2. xls"

The bit in the macro where it states:

"(Now,
"000000"), Visible:=False

I am unclear on?

Many thank for any help

"Paul Betts" <be...@betts11.fsnet.co.uk> wrote in message

news:99t8fk$gqa$1...@news8.svr.pol.co.uk...

[Paul Betts]

Many many thanks for all this work, very much appreciated.
I will try the following and let you know how I get on.

Thanks again

Paul

<mark....@virgin.net> wrote in message
news:3ac27d8b...@news.virgin.net...

[Paul Betts]

Thanks very, for all this Mark.

I will have a bash at this and see how I do.

Thanks again

Paul
<mark....@virgin.net> wrote in message

news:3ac289d...@news.virgin.net...