Restricting Save Priveliges

[AJS]

Hi,

Being a bit of a control freak, I would like to prevent users from implementing either "Save" or "Save As" on my spreadsheet without a password. Is their any easy way of implementing this? A low-security method would be ok - I just want to prevent changes or multiple copies from being made by casual users.

Thanks, Aaron.

[Zack Barresse]

Care of Jacob (past post) ...


Option Explicit

Sub Disable()
With Application.CommandBars("Worksheet Menu Bar").Controls("&File")
.Controls("&Save").Enabled = False
.Controls("Save &As...").Enabled = False
End With
Application.OnKey "^s", ""
End Sub

Sub Enable()
With Application.CommandBars("Worksheet Menu Bar").Controls("&File")
.Controls("&Save").Enabled = True
.Controls("Save &As...").Enabled = True
End With
Application.OnKey "^s"
End Sub

[Jacob Hilderbrand]

If you want to ask for a password we can make our own Save and SaveAs routines. Try this code (The required password is "abc", change as needed). You can then run the DisableIt macro on the workbook open/activate events and EnableIt macro on the before close / deactivate events.



Option Explicit

Sub DisableIt()
Dim CmdBar As CommandBar
Dim CmdCtl As CommandBarControl
For Each CmdBar In CommandBars
Set CmdCtl = CmdBar.FindControl(ID:=3, recursive:=True)
If Not CmdCtl Is Nothing Then CmdCtl.OnAction = "MySave"
Next CmdBar
For Each CmdBar In CommandBars
Set CmdCtl = CmdBar.FindControl(ID:=748, recursive:=True)
If Not CmdCtl Is Nothing Then CmdCtl.OnAction = "MySaveAs"
Next CmdBar
Application.OnKey "^s", ""
Set CmdBar = Nothing
Set CmdCtl = Nothing
End Sub

Sub EnableIt()
Dim CmdBar As CommandBar
Dim CmdCtl As CommandBarControl
For Each CmdBar In CommandBars
Set CmdCtl = CmdBar.FindControl(ID:=3, recursive:=True)
If Not CmdCtl Is Nothing Then CmdCtl.OnAction = ""
Next CmdBar
For Each CmdBar In CommandBars
Set CmdCtl = CmdBar.FindControl(ID:=748, recursive:=True)
If Not CmdCtl Is Nothing Then CmdCtl.OnAction = ""
Next CmdBar
Application.OnKey "^s"
Set CmdBar = Nothing
Set CmdCtl = Nothing
End Sub

Sub MySave()
Dim Prompt As String
Dim Title As String
Dim Password As String
Prompt = "What is the password?"
Title = "Authorized Save Only"
Password = InputBox(Prompt, Title)
If Password = "abc" Then
ThisWorkbook.Save
Else
MsgBox "Incorect Password", vbCritical
End If
End Sub

Sub MySaveAs()
Dim Prompt As String
Dim Title As String
Dim Password As String
Prompt = "What is the password?"
Title = "Authorized Save Only"
Password = InputBox(Prompt, Title)
If Password = "abc" Then
Application.Dialogs(xlDialogSaveAs).Show
Else
MsgBox "Incorect Password", vbCritical
End If
End Sub

[AJS]

Thanks for that! However, the code doesn't seem to be working, so I am probably not putting it in the right place. I have put all of my non-form code (ie, all code activated from buttons directly on the worksheets) into a module, called "Sheet_Module", and I have placed DRJ's code directly at the top of this module, along with the following:




Private Sub Workbook_Open()
DisableIt
End Sub

Private Sub Workbook_Activate()
DisableIt
End Sub

Private Sub Workbook_Close()
EnableIt
End Sub

Private Sub Workbook_Deactivate()
EnableIt
End Sub


But I can still save as per normal. What am I missing here?

Thanks, Aaron.

[Jacob Hilderbrand]

The event code above (open, activate etc.) has to go in the ThisWorkbook module.

[Jacob Hilderbrand]

Also replace your Sub Close macro with this:


Private Sub Workbook_BeforeClose(Cancel As Boolean)

[Richie(UK)]

Hi all,

An alternative approach (pinching some of Jacob's code as an example) would be to make use of the BeforeSave event. Simply add the following to the ThisWorkbook object:


Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Const Prompt As String = "What is the password?"
Const Title As String = "Authorized Save Only"
Const Pwd As String = "abc"
Dim Password As String
Password = InputBox(Prompt, Title)
If Password <> Pwd Then
MsgBox "Incorect Password", vbCritical
Cancel = True
End If
End SubHTH

[CBrine]

Just as an observation. The save override code will not stop someone from copying the entire sheet to a new workbook and saving the new workbook without the code. If you add this code to the This Workbook module it will prevent that from occurring.


Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Application.CutCopyMode = False
End Sub

The user will still be able to do the right click on the worksheet tab and copy from there, but you can prevent that by using the Workbook Protection option.

HTH

[Anne Troy]

Pinching code??
Never!!
LOL!!

[AJS]

Thanks for that, they work well!