Have macro run to protect file with encrypted password

Copper Contributor

I tried to make a macro, by recording a macro, that was supposed to Protect a workbook with an encrypted password when a certain condition was met.  The problem is, that it seems not to be able to record the action of Protecting a workbook with password.  The code is simply empty in the macro for that action.  My problem is, that I need to be able to lock an excel sheet very securely when a certain date is reached.  Is there anyway of doing that ?

4 Replies

@egillhelga  Yes and No.  I want to first say that Excel encryption and password protection is ... let's say ... Not Military grade.  Second, you are switching between protecting the workbook and protecting a sheet.  These are actually 2 different things in Excel.  As for the date I don't know if this is based on a date on a sheet or fixed date or what so I will just use a fixed date and you can substitute a sheet reference if needed.  Lastly, you still need a trigger to run the macro, so I just assumed on open.

So if you open the macro editor (Alt+F11) and double click 'ThisWorkbook' for your workbook (should show on the left in the project directory) then paste the following:

 

 

Private Sub Workbook_Open()
 Dim ws As Worksheet
 If Now() > DateSerial(2020, 1, 31) Then
   ActiveWorkbook.Unprotect "password123"
   ActiveWorkbook.Protect "password123"
   For Each ws In ActiveWorkbook.Sheets
    ws.Protect "password123"
   Next
 End If
End Sub

 

and finally you need to right click on VBAProject (Book1)  or whatever your workbook name is in the Project directory on the left and select VBAProject Properties...  Then in the popup select the 'Protection' tab and set a password (and confirm) so that others can't open this macro editor viewer and see your password.

 

 

@egillhelga 

 

Maybe this VBA code will help you to get ahead in your project.

 

Examble:
Private Sub Worksheet_Change (ByVal Target As Range)
If Range ("F17") <> "Other" Then
With me
.Unprotect "YourPasswort"
.Cells.Locked = False
.Range ("X17: AR18"). Locked = True
.Protect "YourPasswort"
End With
End If
End Sub

 

I would be happy to know if I could help.

 

Nikolino

I know I don't know anything (Socrates)

@mtarler Thank you.  This runs neatly.  But what I needed is not protection of the workbook by utilizing the Review-Protect Workbook function, but rather the function that is available with File-Info-Protect Workbook-Encrypt with Password.

The protection via Review-Protect Workbook, can usually quite easily be bypassed or the password hacked.   

Could your macro be changed to have the function be: File-Info-Protect Workbook-Encrypt with Password?

@egillhelga so this appears to be the same as the Save As option except with the Save As option you can select a PW for open (encryption) and a different PW for edit.  Here is that previous code with both Save As passwords added (and I changed from ActiveWorkbook to ThisWorkbook as that is probably better practice):

Private Sub Workbook_Open()
 Dim ws As Worksheet
 If Now() > DateSerial(2020, 1, 31) Then
   ThisWorkbook.Unprotect "password123"
   ThisWorkbook.Protect "password123"
   For Each ws In ThisWorkbook.Sheets
    ws.Protect "password123"
   Next
 End If
 Application.DisplayAlerts = False
 ThisWorkbook.SaveAs Password:="password123", writeResPassword:="password-to-modify"
 Application.DisplayAlerts = True
End Sub

 Obviously you should change these passwords, but when you open the workbook you will need the first password (password123) and then it will prompt you if you want to open as read only or to enter the password to make changes (password-to-modify).