Assign Expiry Date(Time-Lock) to Excel Workbook

[nabeelahmed]

Dear Friends,

Can somebody help me for subject topic, How can we add expiry date (Time-Lock) to a Excel workbook so that after that date Workbook gets lock and required password to re-validate/Unlock ???

Regards,

 

[nabeelahmed]

Hi Sijpie,

Hope you will be fine.. Actually i am getting this error whenever opening my workbook.. I don't know you can advise here or i should create new thread?

 

[nabeelahmed]

Hi Sijpie,

Hope you will be fine.. Actually i am getting this error whenever opening my workbook.. I don't know you can advise here or i should create new thread?

View attachment 23998

Dear @sijpie Can you please help me to resolve this problem? Appropriate your support.

Thanks

 

[sijpie]

Ah, yes it is trying to set the names again. Modify the WorkBook_Open() sub as follows:

Private Sub Workbook_Open()
     Dim rF as Range

    Set rF=Range(sWBLName) 
    If rF is Nothing Then     FirstTimeSetup
    
    If Range(sWBLName) = True Then Exit Sub ' Workbook has been locked previously, user has unlocked
        
    'Workbook not locked, check if needs locking
    If Date < Range(sLDName) Then Exit Sub  ' Lockdate has not passed, allow user to use workbook
    
    'Workbook needs to be locked, first time
    SetWB2Locked sPW
End Sub

 

[QCLAN]

Like nabeelahmed, when I run the ResetLockDate I get the following error.

 

[sijpie]

Hi QClan,

can you do some debugging, because I don't understand why it would halt here.
When the code stops there, in the VB Editor see if bottom left you have an 'Immediate' window. If not press Ctrl-G to open it (or through the View menu).

In this window, type
?range(sldname).address

Then press enter
The address of the range will appear below the line, or an error message will come up, possibly about an object. Let me know what.

 

[QCLAN]

Hi QClan,

can you do some debugging, because I don't understand why it would halt here.
When the code stops there, in the VB Editor see if bottom left you have an 'Immediate' window. If not press Ctrl-G to open it (or through the View menu).

In this window, type
?range(sldname).address

Then press enter
The address of the range will appear below the line, or an error message will come up, possibly about an object. Let me know what.

The response came back: $A$2

 

[sijpie]

Strange then that it halts here. What is the error message when it halts?

 

[QCLAN]

Strange then that it halts here. What is the error message when it halts?

From the description of your code it should do exactly what I want. I have a complex spreadsheet used to calculate flight (aircraft) prices, times, payload etc. throughout Australia. I am hoping to distribute it but need for the program to lock after a certain date to obtain the next subscription payment. I have multiple tabs (with multiple locked cells) in this workbook and so far none of them have locked on the set date. Am I missing something? I have also attached the images for the error I am receiving for the 'ResetLockDate'. Thanks for your help.

 

[sijpie]

Ah, ok. That makes things a bit clear. What is happening is that the sheet holding the variables itself is being locked, although I coded it so it wouldn't be. I need to check in detail again . Shouldn't be too difficult.

 

[sijpie]

DOn't understand why it isn't working in your case. It works fine on my test.

However, in the amended code below I force the hidden worksheet to be unlocked.

Replace the sub in your code with this one

Sub ResetLockDate()
'Allows authorised user to change the lock date
    Dim vP
    Dim dDt As Date
    Dim sMsg As String
    
    vP = InputBox(prompt:="Please enter password to change the lockdate for this workbook", _
                Title:="Password required")
    If vP = sPW Then
        dDt = GetDate
        If dDt <= Date And Date > Range(sLDName) Then
            MsgBox "Date provided does not make sense: the workbook is already locked. No action taken."
        Else
            Sheets(sHDName).Unprotect sPW
            Range(sLDName) = dDt
            If Range(sWBLName) Then
                UnlockSheets sPW
                Range(sWBLName) = False
                sMsg = "All worksheets have been unlocked. " & vbCrLf
            End If
            MsgBox sMsg & "Lock date set to: " & Format(dDt, "short date")
        End If
    Else
        MsgBox "Incorrect or no password given. No action taken"
    End If
End Sub