How to Make an Excel Spreadsheet Expire

Status
Not open for further replies.

ngs007

New Member
Joined
Jul 28, 2013
Messages
21
Hi

I want to create a spreadsheet that automatically prevents users from being able to view or edit the document after a specific date and that provides users with a message regarding the expiration date and the number of days left until the spreadsheet expires

 

Excel Facts

Copy PDF to Excel
Select data in PDF. Paste to Microsoft Word. Copy from Word and paste to Excel.
You can use the Workbook_Open event to monitor a hidden cell with the current date.

See Chip Pearson's Timebombing A Workbook

Just note that there are potential legal issues if you prevent a user from accessing their own data.
 
Upvote 0
Hi Thanks Smitty but I didnt get the timebomb...I tried it but was not sure what to replace with my own dates etc. I also tried it exactly as it was and unsure if it worked or not
 
Upvote 0
If you used the first routine, then the initial date is set when the code first runs, but you could replace it if you wanted:

Rich (BB code):
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

Note that you need to include the constant that he defined:

Private Const C_NUM_DAYS_UNTIL_EXPIRATION = 30

If you want to test it, just change your system date to extend past your expiration date (which will also serve as an example of how weak this type of thing is).
 
Upvote 0
ok many thanks - post closed

Glad I could help.

Just an FYI that we don't mark threads solved, but leave them open for everyone, generally in case 1) someone comes along with a different approach or 2) someone has a similar question.
 
Upvote 0
This is good information, and I could use it. But where would I insert the Suicide code in this code so the file is deleted after 30 days?

Code:
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
 
Upvote 0
Hi Jim

I believe the fundamentals have been provided. It's a touchy subject because so often the developer is not actually the owner of the IP, and we don't want any risk by being part of a solution that actually deletes someone's file from their system. Rather try and adapt the given solution to your own needs and then I respectfully ask that you keep that code to yourself rather than publish it in our public domain.

For this reason I'm going to close this thread. I hope you understand.
 
Upvote 0
Status
Not open for further replies.

Forum statistics

Threads
1,223,908
Messages
6,175,305
Members
452,633
Latest member
DougMo

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top