Assign Expiry Date(Time-Lock) to Excel Workbook

Status
Not open for further replies.

nabeelahmed

Board Regular
Joined
Jun 19, 2020
Messages
76
Office Version
  1. 365
Platform
  1. Windows
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,
 
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?

1602395048206.png
 
Upvote 0

Excel Facts

Remove leading & trailing spaces
Save as CSV to remove all leading and trailing spaces. It is faster than using TRIM().
Ah, yes it is trying to set the names again. Modify the WorkBook_Open() sub as follows:

VBA Code:
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
 
Upvote 0
Like nabeelahmed, when I run the ResetLockDate I get the following error.
 

Attachments

  • Screen Shot 2022-05-24 at 14.06.25.png
    Screen Shot 2022-05-24 at 14.06.25.png
    168.3 KB · Views: 17
Upvote 0
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.
 
Upvote 0
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
 
Upvote 0
Strange then that it halts here. What is the error message when it halts?
 
Upvote 0
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.
 

Attachments

  • Screen Shot 2022-05-26 at 16.33.23.png
    Screen Shot 2022-05-26 at 16.33.23.png
    106.3 KB · Views: 11
  • Screen Shot 2022-05-26 at 16.32.39.png
    Screen Shot 2022-05-26 at 16.32.39.png
    64.6 KB · Views: 11
Upvote 0
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.
 
Upvote 0
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
VBA Code:
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
 
Upvote 0
Status
Not open for further replies.

Forum statistics

Threads
1,223,099
Messages
6,170,107
Members
452,302
Latest member
TaMere

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