Excel File Expiry Coding with Renew Option

Dear Forum Experts,

I have been trying to develop VBA Coding for File Expiry which allows the user to Renew by inputting the password by "user form" for every 8 Months otherwise file should be closed.

Here I attached sample file which contains VBA Coding to Check expiry date and closes the file immediately, I want to upgrade the coding as above.


Thank you...

Dear Forum Experts,

Any Update Please...

See the attached file which I think does what you're asking for.

This goes in the Workbook_Open() event - there are two commented out lines which you should uncomment in the real code so that users cannot unhide the sheet that contains the expiry date and password.

Option Explicit

Public Sub Workbook_Open()
'check if an expiry date has been set - if not set to now + 8 months.
Dim wksHidden As Worksheet
Dim celDate As Range
Dim datExpiry As Date

    Set wksHidden = ThisWorkbook.Worksheets("DateStore")
    'wksHidden.Visible = xlSheetHidden
    Set celDate = wksHidden.Range("A1")
    If celDate.Value = Empty Then celDate.Value = DateAdd("m", 8, Now())
    datExpiry = celDate.Value
    If Now() > datExpiry Then Call Reset.Reset_Initialize
    'wksHidden.Visible = xlSheetVeryHidden
    
End Sub

And this goes in the form object:

Option Explicit

Public Sub btnClose_Click()
    Unload Me
End Sub

Public Sub btnReset_Click()
Dim strPW As String
Dim varMsg As Variant

    strPW = Trim(Me.txtPassword)
    If strPW = ThisWorkbook.Worksheets("DateStore").Range("B1").Value Then
        ThisWorkbook.Worksheets("DateStore").Range("A1").Value = DateAdd("m", 8, Now())
        varMsg = MsgBox("The file expiry date has been extended by 8 months and will now expire on " & Format(ThisWorkbook.Worksheets("DateStore").Range("A1").Value, "dd mmm yyyy"), vbInformation + vbOKOnly, "Code accepted")
    Else
        varMsg = MsgBox("You have entered an incorrect password and the expiry date will not be extended.", vbCritical + vbOKOnly, "Incorrect password")
    End If
    Call btnClose_Click
    
End Sub

Public Sub Reset_Initialize()
Dim strFilename As String
    
    strFilename = Left(ActiveWorkbook.Name, (InStrRev(ActiveWorkbook.Name, ".", -1, vbTextCompare) - 1))
    Me.Caption = strFilename & " File  - Registration Key"
    Me.Show

End Sub

Hope that helps. MM.

Thank you,,,


its working......

Yes but most people don't code to get around all the tricks a user might try ... if someone really wants to break it, they will.

@ Arshad - if you want to get around this issue, then just call the code at the start of the main code; you can declare a global variable (like "booChecked") as Boolean so you only run it once. Or just leave it if you think your users are not malicious.

Yes I'm aware ... my view stands though - for normal purposes, I don't think it's worth coding for purposeful evasion of functionality.

If you save your worksheets as very hidden

Then use your macro to unhide them

Then your worksheets cannot be viewed if Macros are disabled.

yep - as in the code I provided :-)