How to Make an Excel Spreadsheet Expire

[ngs007]

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

 

[Smitty]

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.

 

[ngs007]

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

 

[Smitty]

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:

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).

 

[ngs007]

ok many thanks - post closed

 

[Smitty]

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.

 

[Jim885]

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?

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

 

[Jon von der Heyden]

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.