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 Sub

HTH

[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!