[Last Call] Learn how to a build a cloud-first strategyRegister Now

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 294
  • Last Modified:

How to use VBA to ensure "Read-Only" access to excel doesn't allow editing/saving as a copy

I have a shared Excel file for a client in which many employees have to view, but only a limited few can actually edit it.

In that case, I decided to do the basic protection in the saving general settings. This asked for a password when opening the file or gave the option for "read-only." When opened in "read-only," you were still allowed to edit the file and save it as a copy. In that case, everyone would just edit it and save copies all over the server.

My next step was to use a macros in Excel 2010 VBA, in which requested a password when saving the file. This worked great but in order to work, you need to "enable macros."

Then I decided to find a macros that would essentially force users to enable their macros. This would show a sheet requesting the user to enable their macros before they could see the other sheets in the workbook. This worked, but when exiting the workbook, it would consider enabling the macros as an edit, requesting a save. The problem is it wants a password to save and I am not sure why.

I started to develop conflict and need a point in the correct direction. I am not sure whether or not there is an easier way to go about this then some macros in the VBA.

The following is the code I recently had in my workbook.

Option Explicit
 
Private Sub Workbook_Open()
     
    With Application
         'disable the ESC key
        .EnableCancelKey = xlDisabled
        .ScreenUpdating = False
         
        Call UnhideSheets
         
        .ScreenUpdating = True
         're-enable ESC key
        .EnableCancelKey = xlInterrupt
    End With
     
End Sub
 '
Private Sub UnhideSheets()
     '
    Dim Sheet As Object
     '
    For Each Sheet In Sheets
        If Not Sheet.Name = "Prompt" Then
            Sheet.Visible = xlSheetVisible
        End If
    Next
     '
    Sheets("Prompt").Visible = xlSheetVeryHidden
     '
    Application.Goto Worksheets(1).[A1], True '< Optional
     '
    Set Sheet = Nothing
    ActiveWorkbook.Saved = True
     
End Sub
 
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    With Application
        .EnableCancelKey = xlDisabled
        .ScreenUpdating = False
         
        Call HideSheets
         
        .ScreenUpdating = True
        .EnableCancelKey = xlInterrupt
    End With
End Sub
 
Private Sub HideSheets()
     '
    Dim Sheet As Object '< Includes worksheets and chartsheets
     '
    With Sheets("Prompt")
         '
         'the hiding of the sheets constitutes a change that generates
         'an automatic "Save?" prompt, so IF the book has already
         'been saved prior to this point, the next line and the lines
         'relating to .[A100] below bypass the "Save?" dialog...
        If ThisWorkbook.Saved = True Then .[A100] = "Saved"
         '
        .Visible = xlSheetVisible
         '
        For Each Sheet In Sheets
            If Not Sheet.Name = "Prompt" Then
                Sheet.Visible = xlSheetVeryHidden
            End If
        Next
         '
        If .[A100] = "Saved" Then
            .[A100].ClearContents
            ThisWorkbook.Save
        End If
         '
        Set Sheet = Nothing
    End With
     '
End Sub

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim Password As String
Dim EnteredPassword As String

Password = "password1"
EnteredPassword = InputBox("Enter password to save changes")
If EnteredPassword <> Password Then
Cancel = True
MsgBox ("Password incorrect, file not saved")
End If

End Sub

Open in new window


I have attached the "test" Excel 2010 file that I am experimenting this with. All of the passwords are "password1". I would appreciate any help available. Thank you.

Michael
test.xlsm
0
Larrydz
Asked:
Larrydz
  • 6
  • 4
  • 2
  • +1
1 Solution
 
jkpieterseCommented:
Quick tip: You can prevent the events from running at will by :
Application.EnableEvents = False
Do not forget to set it back to true when you are done however!
ALternatively:
http://www.jkp-ads.com/Articles/NoEvents00.asp
0
 
aikimarkCommented:
Have you considered replacing their normal File menu with a menu that doesn't include Save and Save As items?

Are you concerned with the ability of someone to create a copy if the data via copy/paste?
0
 
LarrydzAuthor Commented:
There are a number of employees that must gain editing abilities to this file daily. As per the copy/paste ability I am not to worried about. I just need to get this client a more secure workbook to ensure restricted users do not decide to change some data around. If there is a successful way to make this file a "read-only" without the ability to save it in any way shape or form, that would be fine. This would be as long as there is a password to allow certain users to edit and save it.
0
NEW Veeam Agent for Microsoft Windows

Backup and recover physical and cloud-based servers and workstations, as well as endpoint devices that belong to remote users. Avoid downtime and data loss quickly and easily for Windows-based physical or public cloud-based workloads!

 
aikimarkCommented:
The removal action of the Save and Save As menu items would only apply to those people who are NOT allowed to save.  Those people with rights to save would see the Save/Save As menu items.
0
 
LarrydzAuthor Commented:
aikimark, by any chance could you clarify what you mean by removing the save and save as menu items? I know this could be done easily via VBA but don't understand how it would be available to the people with rights to actually edit and save it. Thank you for your help.
0
 
aikimarkCommented:
As part of the actions you take when the workbook is opened, you might remove/hide/disable the menu items.
0
 
LarrydzAuthor Commented:
For my issue, I have not been delivered an acceptable solution and was wondering if there were any other options/clarifications out there. Thank you for your help.
0
 
aikimarkCommented:
click the request attention link and ask for more expert participation.
0
 
jkpieterseCommented:
I would do it like so:

Option Explicit
 
Private Sub Workbook_Open()
     
    With Application
         'disable the ESC key
        .EnableCancelKey = xlDisabled
        .ScreenUpdating = False
         
        Call UnhideSheets
         
        .ScreenUpdating = True
         're-enable ESC key
        .EnableCancelKey = xlInterrupt
    End With
     
End Sub
 '
Private Sub UnhideSheets()
     '
    Dim Sheet As Object
     '
    For Each Sheet In Sheets
        If Not Sheet.Name = "Prompt" Then
            Sheet.Visible = xlSheetVisible
        End If
    Next
     '
    Sheets("Prompt").Visible = xlSheetVeryHidden
     '
    Application.Goto Worksheets(1).[A1], True '< Optional
     '
    Set Sheet = Nothing
    ActiveWorkbook.Saved = True
     
End Sub
 
 
Private Sub HideSheets()
     '
    Dim Sheet As Object '< Includes worksheets and chartsheets
     '
    With Sheets("Prompt")
         '
         'the hiding of the sheets constitutes a change that generates
         'an automatic "Save?" prompt, so IF the book has already
         'been saved prior to this point, the next line and the lines
         'relating to .[A100] below bypass the "Save?" dialog...
        If ThisWorkbook.Saved = True Then .[A100] = "Saved"
         '
        .Visible = xlSheetVisible
         '
        For Each Sheet In Sheets
            If Not Sheet.Name = "Prompt" Then
                Sheet.Visible = xlSheetVeryHidden
            End If
        Next
         '
        If .[A100] = "Saved" Then
            .[A100].ClearContents
            ThisWorkbook.Save
        End If
         '
        Set Sheet = Nothing
    End With
     '
End Sub

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Dim Password As String
    Dim EnteredPassword As String

    Password = "password1"
    EnteredPassword = InputBox("Enter password to save changes")
    If EnteredPassword <> Password Then
        Cancel = True
        MsgBox ("Password incorrect, file not saved")
    Else
        HideSheets
        'Make sure sheets are unhidden when save is done
        Application.OnTime Now, "Thisworkbook.Unhidesheets"
    End If
End Sub

Open in new window

0
 
LarrydzAuthor Commented:
Thank you for your response jkpieterse, but I am getting an error at the "Sheet Visible = xl SheetVeryHidden"

For Each Sheet In Sheets
            If Not Sheet.Name = "Prompt" Then
            Sheet.Visible = xlSheetVeryHidden
            End If

Open in new window

0
 
FarWestCommented:
is it acceptable for you/your client to embed this excel file within another Executable?
0
 
LarrydzAuthor Commented:
My current configuration is working for the client, and if any other issues arrive I will be sure to use Experts Exchange for more information. Thank you to anyone who has posted a potential solution.
0
 
LarrydzAuthor Commented:
My current configuration is working
0

Featured Post

Free Tool: Subnet Calculator

The subnet calculator helps you design networks by taking an IP address and network mask and returning information such as network, broadcast address, and host range.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

  • 6
  • 4
  • 2
  • +1
Tackle projects and never again get stuck behind a technical roadblock.
Join Now