Expiry date of Excel Sheet

[sachin katariya]

I have coding of expiry of excel
But what if I Change the date of my PC manually ?

Private Sub Workbook_Open()
Application.Visible = False
Application.Calculation = xlCalculationManual
If Application.Version < "15.0" Then
MsgBox "This Software is not Compatible with this Version of Application. Please Install Microsoft Office 2013 or Above"
Application.Quit
Exit Sub
Else
On Error Resume Next
Dim Expiry As Date
Dim wb As Workbook: Set wb = SHEET
Expiry = wb.Worksheets("Data").Range("B1")
If Date > Expiry Then
Application.DisplayAlerts = False
MsgBox "This Sheet is Expired on " & Expiry

For Each wsSheet In Worksheets
If wsSheet.Name = "Data" Then
wsSheet.Visible = True
Else
wsSheet.Visible = xlSheetVeryHidden
End If
Sheets("Data").Select
Next wsSheet

Application.DisplayAlerts = True
Else

Worksheets("Dashboard").Visible = True
MsgBox "You have " & Expiry - Date & " Day(s) left. Your Sheet will expire on " & Expiry
For Each wsSheet In Worksheets
If wsSheet.Name = "Dashboard" Or wsSheet.Name = "Data" Then
wsSheet.Visible = True
Else
wsSheet.Visible = False
End If
Next wsSheet
Sheets("Dashboard").Select

End If
End If
Application.Visible = True
Application.Calculation = xlCalculationAutomatic
End Sub

 

[Anthony47]

And what if I open the workbook but disable its macros? And what if I change the expiring date in Data!B1? And what if I remove the Workbook_Open macro?
If you plan using the trick to prevent using the workbook after a certain date, well don't forget there are many ways to avoid the lock. If your goal is avoid that the users use old information, then just rise a message box that inform "A new version is available, download it from >>here<<"

And by the way, don't send me your workbook: when your macro will close my application, potentially cancelling my last unsaved modification, I should be very angry (very-very-angry) with someone.
So my suggestion is that you remove that Application.Quit and use a less dangerous ThisWorkbook.Close False

Bye