Hi Gord
OK Thanks for your help. I've inserted the module into my wb with this
as the code :
Private Const C_NUM_DAYS_UNTIL_EXPIRATION = 1
Sub TimeBombMakeReadOnly()
'''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''
' TimeBombMakeReadOnly
' This procedure uses a defined name to store the expiration
' date and if the workbook has expired, makes the workbook
' read-only.
'''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''
Dim ExpirationDate As String
Dim NameExists As Boolean
On Error Resume Next
ExpirationDate = Mid(ThisWorkbook.Names("ExpirationDate").Value, 2)
If Err.Number < 0 Then
'''''''''''''''''''''''''''''''''''''''''''
' Name doesn't exist. Create it.
'''''''''''''''''''''''''''''''''''''''''''
ExpirationDate = CStr(DateSerial(Year(Now), _
Month(Now), Day(Now) + C_NUM_DAYS_UNTIL_EXPIRATION))
ThisWorkbook.Names.Add Name:="ExpirationDate", _
RefersTo:=Format(ExpirationDate, "short date"), _
Visible:=False
NameExists = False
Else
NameExists = True
End If
'''''''''''''''''''''''''''''''''''''''''''''''''' ''''
' If the today is past the expiration date, make the
' workbook read only. We need to Save the workbook
' to keep the newly created name intact.
'''''''''''''''''''''''''''''''''''''''''''''''''' ''''
If CDate(Now) = CDate(ExpirationDate) Then
If NameExists = False Then
ThisWorkbook.Save
End If
ThisWorkbook.ChangeFileAccess xlReadOnly
End If
End Sub
i hope this is how it's meant to be. I haven't changed anything ,
although I made it one day so that I can see if it works by tomorrow.
I have a small question :
I really need this routine to start counting down as soon as the wb is
opened for the first time , on any machine. Does the macro have to be
run to set it working on each machine? If so , it sort of defeats the
object...!
Also , could you suggest some code to bring up a message box to show the
wb has expired?
Thanks
Colin
In article , Gord Dibben
<gorddibbATshawDOTca@?.? writes
See in-line responses..............
On Fri, 30 Nov 2007 13:35:38 +0000, Colin Hayes
wrote:
Hi
OK Thanks. I thought I'd try the one below.
I have a couple of questions though , if you could advise ;
The workbook it's protecting is called 'Receipts' - do I need to put
this anywhere in the code?
No. Thisworkbook is the workbook you are running the Sub on.
If I use this on more than one wb , do I need to change the name of the
file it stores , so as not to overwrite it.
No changes necessary as far as I can tell.....Thisworkbook refers to whatever
workbook the code is in.
I assume the file it is
storing is 'Expiration date'. It's not clear to me where it stores the
file....
Expiration Date is a named range which holds the date to expire. The code
creates this named range.
The line...........Private Const C_NUM_DAYS_UNTIL_EXPIRATION = 90 must be
placed above the line..........Sub TimeBombMakeReadOnly()
Also , I'm not sure where I should be placing the code in the workbook.
Under the tab at the bottom , or under the Excel symbol at top-left of
the sheet...?
Alt + F11 to open VB Editor
CTRL + r to open Project Explorer if not visible.
Right-click on your workbook and InsertModule.
Paste code into that module with the edits above.
Save the workbook then run the macro which sets the time to expire as 90 days
from when you run the macro.
Have you downloaded the sample workbook from Chip's site to see how he has
done
it?
Gord
Sub TimeBombMakeReadOnly()
'''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''
' TimeBombMakeReadOnly
' This procedure uses a defined name to store the expiration
' date and if the workbook has expired, makes the workbook
' read-only.
'''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''
Dim ExpirationDate As String
Dim NameExists As Boolean
On Error Resume Next
ExpirationDate = Mid(ThisWorkbook.Names("ExpirationDate").Value, 2)
If Err.Number < 0 Then
'''''''''''''''''''''''''''''''''''''''''''
' Name doesn't exist. Create it.
'''''''''''''''''''''''''''''''''''''''''''
ExpirationDate = CStr(DateSerial(Year(Now), _
Month(Now), Day(Now) + C_NUM_DAYS_UNTIL_EXPIRATION))
ThisWorkbook.Names.Add Name:="ExpirationDate", _
RefersTo:=Format(ExpirationDate, "short date"), _
Visible:=False
NameExists = False
Else
NameExists = True
End If
'''''''''''''''''''''''''''''''''''''''''''''''' ''''''
' If the today is past the expiration date, make the
' workbook read only. We need to Save the workbook
' to keep the newly created name intact.
'''''''''''''''''''''''''''''''''''''''''''''''' ''''''
If CDate(Now) = CDate(ExpirationDate) Then
If NameExists = False Then
ThisWorkbook.Save
End If
ThisWorkbook.ChangeFileAccess xlReadOnly
End If
End Sub
Thanks again.
In article , Gord Dibben
<gorddibbATshawDOTca@?.? writes
Colin
See Chip Pearson's site for creating a Time Bombed workbook.
http://www.cpearson.com/excel/workbooktimebomb.aspx
Gord Dibben MS Excel MVP
On Fri, 30 Nov 2007 01:52:58 +0000, Colin Hayes
wrote:
Hi
I need to have an excel file 'expire' 3 months after first installation.
Is it possible to build something into the program so that it will read
the date on first use and stop functioning after a set time , perhaps
with a popup too?
Any help appreciated.
Thanks