PDA

View Full Version : Solved: workbook protection allowing admin / user access



nbqleebarnes
10-17-2008, 10:47 PM
Hi All,
I am very new to VBA code and I am trying to write code for user / admin protection to allow unprotecting cells or not, I have attached the logic in the form of a flow chart.
I would be very thankful if anyone can help me.
Cheers
Lee

GTO
10-17-2008, 11:02 PM
Greetings,

You may wish to review http://www.vbaexpress.com/kb/getarticle.php?kb_id=531

as well as a recent thread dealing in a similar area:

http://www.vbaexpress.com/forum/showthread.php?t=22600

As to the workbook's expiration date, there is also at least one really good (a couple I believe) articles in the KB section.

While these probably won't get you "all the way there", I would read, as they'll give ideas as to how to handle.

Happy coding and welcome,

Mark

nbqleebarnes
10-19-2008, 01:17 AM
Thanks very much Mark,
I have looked at the coding from these links.
They work perfectly with a bit of change to suit my design.
Although I do have a program that will unprotect the work sheet no matter what the password is, I am trying to write code to stop people from using this program, the only piece of code that I am struggling with is the part where the ELSE command then delete formulas or KILL all sheets / file.
Thanks for your input.
Cheers
Lee

nbqleebarnes
10-19-2008, 03:11 AM
I have just worked out the code that will replace all formulas in my sheets with the numeric value, which is just as good as deleting the sheet.
I must just try compiling the code for the logic:
Sub test()
If Intersect(Target, Range("C5")) Is Unprotect Then
With ThisWorkbook.Sheets("Sheet1").UsedRange
.Value = .Value
End With
Else
End Sub

I know that the code unprotect is wrong but how do I ask if a cell value is unprotected, (even by the correct password), then replace formulas with numeric value.
Cheers
Lee

GTO
10-19-2008, 04:26 AM
...I must just try compiling the code for the logic:

Sub test()
If Intersect(Target, Range("C5")) Is Unprotect Then
With ThisWorkbook.Sheets("Sheet1").UsedRange
.Value = .Value
End With
Else
End Sub

I know that the code unprotect is wrong but how do I ask if a cell value is unprotected, (even by the correct password), then replace formulas with numeric value.
Cheers
Lee

Hello Lee,
As you appear aware that no matter what you do, in that Excel's known weaknesses can certainly be exploited by more than one program out there, attempting to build a bit of security is always helpful, as regardless of all, it decreases the chance that casual 'good-intentioned' users don't inadvertantly goober up the workbook.

To that end, I believe that you are actually looking to see if a particular sheet has become unprotected, instead of looking at whether a particular cell is "unprotected".

To wit: a cell's Locked property could be True or False, but this isn't really what you are looking for, as all cells are Locked by default. Instead, it is whether Protection has been "turned on" for the sheet.
For that, something like:

Sub Whatever()
'// pass the sheet as an object//
SheetIsProtected Sheet1
End Sub

Sub SheetIsProtected(oSheet As Worksheet)
With oSheet.UsedRange
If oSheet.ProtectContents = False _
Or oSheet.ProtectDrawingObjects = False _
Or oSheet.ProtectScenarios = False Then
.Value = .Value
End If
End With
End Sub

Hopefully that helps a bit,

Mark

nbqleebarnes
10-19-2008, 04:55 AM
That works perfect and is exactly what I need, I will add it to my expiry and main macro.
I agree that any excel program is not safe but we can only but try to safe guard as much as we can against the amateur user.
Saying that I must allow my users to be able to use the program.
Just one other question I have is how do I make your code work automatically when a sheet is unprotected.
I am sure this is a bit of a stupid question. But having a blonde day.
Thanks for your help
Cheers
Lee

GTO
10-19-2008, 06:45 AM
Hey Lee,

There are no 'stupid' questions, but occassionally a 'thick' reader, to wit, me. I'm afraid I'm not sure as what you mean by automatically working when a sheet is unprotected?

You could have it check to see if the sheet is protected whenever a sheet is activated, like:

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
If Not UCase(Environ("UserName")) = "MARK" Then
SheetIsProtected Sh
End If
End Sub

...by placing the above in the ThisWorkbook Module. Please note that I pre-empted (spelling?) it from running if it's me, as you won't want to delete all your formulas if you have the workbook open and a sheet unprotected for developmental purposes. (I would certainly save a copy of my project before I tried this, just to avoid such a scenario)

Mark

nbqleebarnes
10-19-2008, 06:56 AM
Thanks for your good input to solving my problem Mark, I have figured it out eventually, I think it will help in the big picture of my excel workbooks.
I have used the following code:
Private Sub Worksheet_Activate()
'// pass the sheet as an object//
SheetIsProtected sheet1
End Sub
Sub SheetIsProtected(oSheet As Worksheet)
With oSheet.UsedRange
If oSheet.ProtectContents = False _
Or oSheet.ProtectDrawingObjects = False _
Or oSheet.ProtectScenarios = False Then
.Value = .Value
End If
End With
End Sub

Used this on each sheet and every time I click on the tab the formulas dissapear, it's great. I will remember to save a copy of my master, before I put it into my workbooks, that is why I have a user password and an admin password at the front of the workbook, I also put in an expiry period, protected the macros, I think that this is as much as I can do for protection for my users.
Thanks again for help.

Cheers
Lee
:thumb

GTO
10-19-2008, 07:40 AM
Glad to be of help Lee. Just to clarify, if you're putting the sub under each sheet's module, I believe you might want to simply call the procedure thusly:
Private Sub Worksheet_Activate()
SheetIsProtected ActiveSheet
End Sub

...as 'sheet1' (at least the way its written) represents just the object 'sheet1'. Hopefully I'm not pointing out something you're already taking into account.

Anyways, glad its working for you, and have a good evening,

Mark

PS - I should have mentioned this earlier. When pasting code into the message window, first click on the little green and white button that says "VBA". Then just paste the code between the tags. Makes is a lot easier to read :-)

nbqleebarnes
10-19-2008, 07:54 AM
Thanks for all your help Mark,
I will make the adjustments you mentioned.
Cheers
Lee

nbqleebarnes
10-20-2008, 01:24 AM
Hi there again,
I input the code into my form as I require different access for user or admin which is as follows:
Private Sub CommandButton1_Click()
If Sheet15.Range("C1").Value = "user" Then
UserForm1.Hide
Sheet1.Visible = xlSheetVisible
Sheet2.Visible = xlSheetVisible
Sheet3.Visible = xlSheetVisible
Sheet4.Visible = xlSheetVisible
Sheet5.Visible = xlSheetVisible
Sheet6.Visible = xlSheetVisible
Sheet7.Visible = xlSheetVisible
Sheet8.Visible = xlSheetVisible
Sheet9.Visible = xlSheetVisible
Sheet10.Visible = xlSheetVisible
Sheet11.Visible = xlSheetVisible
Sheet12.Visible = xlSheetVisible
Sheet13.Visible = xlSheetVisible
Sheet14.Visible = xlSheetVisible
Sheet15.Visible = xlSheetVeryHidden
Chart16.Visible = xlSheetVisible
Chart17.Visible = xlSheetVisible
Chart18.Visible = xlSheetVisible
Chart19.Visible = xlSheetVisible
Chart20.Visible = xlSheetVisible
Chart21.Visible = xlSheetVisible
Chart22.Visible = xlSheetVisible
Chart23.Visible = xlSheetVisible
Chart24.Visible = xlSheetVisible
Chart25.Visible = xlSheetVisible
Chart26.Visible = xlSheetVisible
Chart27.Visible = xlSheetVisible
Chart28.Visible = xlSheetVisible
Sheet1.Select
Sheet15.Range("C1").Clear
Call Sheet1.Activate
Call Sheet2.Activate
Call Sheet3.Activate
Call Sheet4.Activate
Call Sheet5.Activate
Call Sheet6.Activate
Call Sheet7.Activate
Call Sheet8.Activate
Call Sheet9.Activate
Call Sheet10.Activate
Call Sheet11.Activate
Call Sheet12.Activate
Call Sheet13.Activate
Call Sheet14.Activate
Else
If Sheet15.Range("C1").Value = "admin" Then
UserForm1.Hide
Sheet1.Visible = xlSheetVisible
Sheet2.Visible = xlSheetVisible
Sheet3.Visible = xlSheetVisible
Sheet4.Visible = xlSheetVisible
Sheet5.Visible = xlSheetVisible
Sheet6.Visible = xlSheetVisible
Sheet7.Visible = xlSheetVisible
Sheet8.Visible = xlSheetVisible
Sheet9.Visible = xlSheetVisible
Sheet10.Visible = xlSheetVisible
Sheet11.Visible = xlSheetVisible
Sheet12.Visible = xlSheetVisible
Sheet13.Visible = xlSheetVisible
Sheet14.Visible = xlSheetVisible
Sheet15.Visible = xlSheetVeryHidden
Chart16.Visible = xlSheetVisible
Chart17.Visible = xlSheetVisible
Chart18.Visible = xlSheetVisible
Chart19.Visible = xlSheetVisible
Chart20.Visible = xlSheetVisible
Chart21.Visible = xlSheetVisible
Chart22.Visible = xlSheetVisible
Chart23.Visible = xlSheetVisible
Chart24.Visible = xlSheetVisible
Chart25.Visible = xlSheetVisible
Chart26.Visible = xlSheetVisible
Chart27.Visible = xlSheetVisible
Chart28.Visible = xlSheetVisible
Sheet1.Select
Sheet15.Range("C1").Clear
Else
UserForm2.Show
End If
End If
End Sub

Then I have put into each sheet:
Private Sub Worksheet_Activate()
SheetIsProtected ActiveSheet
End Sub

Sub SheetIsProtected(oSheet As Worksheet)
With oSheet.UsedRange
If oSheet.ProtectContents = False _
Or oSheet.ProtectDrawingObjects = False _
Or oSheet.ProtectScenarios = False Then
.Value = .Value
End If
End With
End Sub

Although whether I login as the user or admin then the formulas still dissapear no matter who I log in as.
I am using user form 1 as the input for the password and user form 2 to display "incorrect password".
I am sure I am missing something simple.
Hope you can help.
Cheers
Lee

GTO
10-20-2008, 01:31 AM
Hello Lee,

I am late for hitting the rack (going to bed), but post an example workbbok, and someone will take a look or I'll get to tomorrow (er, today) afternoon. You can indeed shorten this up...

Mark

nbqleebarnes
10-20-2008, 02:48 AM
Hi Mark,
Keep forgetting you are on totally different time zone.
I have attached an example file with the code I'm using, I have had to protect the sheets, but I have not used any password, obviously because the moment I unprotect them and select the tab, then the formula dissapears.
You will see in the file that there is also a expiry code in there, the passwords that I have written in the code are "user" and "admin".
Get some sleep, chat later.
Cheers
Lee

nbqleebarnes
10-21-2008, 01:47 AM
Hi there,
I did add a macro enable code aswell that I found and I just need to get the code right for the user and admin access control.
I have added an example of the workbook.
Thanks in advance
Lee

GTO
10-21-2008, 06:41 AM
Hello Lee,
Afraid yesterday was (and today may be as well) a bit busy. That said, I had a chance to
look at your workbook, albeit a very cursory look.
I applaud you, as it is clear to me that you are making great efforts in researching
articles from the KB here before asking. That said, I have noted some 'issues' in the way
things are currently working in the workbook (wb).
So... I will make at least one, if not more, suggestions as to changing a couple of things
up, that I believe will benefit - as in looking at the wb, it appears to me that correcting
these will make the smaller issues easier to resolve.
Hope that made sense, but maybe an example would be a better way of demonstrating
this, plus, I don't like being 'mysterious' as the goal is to be of help.
By example:
You end up with two opening events, as you have both a 'Private Sub Workbook_Open()'
(under the ThisWorkbook module) and 'Sub auto_open()' (under Module11). In gist, 'auto_open'
is antiquated and provided for backwards compatability, but has been replaced by
'Workbook_Open'.
As I don't use auto_open, I tested and believe that Workbook_Open processes first, thus - my
first suggestion would be to take everything in auto_open and place it below the code
currently in Workbook_Open, like:

Private Sub Workbook_Open()
Dim StartTime#, CurrentTime#

With Application
'disable the ESC key
.EnableCancelKey = xlDisabled
.ScreenUpdating = False

Call UnhideSheets

.ScreenUpdating = True
're-enable ESC key
.EnableCancelKey = xlInterrupt
End With
'*****************************************
'SET YOUR OWN TRIAL PERIOD BELOW
'Integers (1, 2, 3,...etc) = number of days use
'1/24 = 1Hr, 1/48 = 30Mins, 1/144 = 10Mins use

Const TrialPeriod# = 365 '< 1 year trial
'set your own obscure path and file-name
Const ObscurePath$ = "C:\"
Const ObscureFile$ = "TestFileLog.Log"
'*****************************************
If Dir(ObscurePath & ObscureFile) = Empty Then
StartTime = Format(Now, "#0.#########0")
Open ObscurePath & ObscureFile For Output As #1
Print #1, StartTime
UserForm1.Show
Else
Open ObscurePath & ObscureFile For Input As #1
Input #1, StartTime
CurrentTime = Format(Now, "#0.#########0")
If CurrentTime < StartTime + TrialPeriod Then

Close #1
UserForm1.Show
Exit Sub
Else
If [A1] <> "Expired" Then
MsgBox "Sorry, your trial period has expired - your data" & vbLf & _
"will now be extracted and saved for you..." & vbLf & _
"" & vbLf & _
"This workbook will then be made unusable."
Close #1
SaveShtsAsBook
[A1] = "Expired"
ActiveWorkbook.Save
Application.Quit
ElseIf [A1] = "Expired" Then
Close #1
Application.Quit
End If
End If
End If
Close #1
End Sub

...this way, we can step-thru the code and see what is happening.

Again, I hope that made sense...

Mark

nbqleebarnes
10-21-2008, 10:08 AM
Hi Mark,
Thanks for taking time to give me a hand while you are busy, I put the code into the workbook and it now looks like this:
Option Explicit

Private Sub Workbook_Open()
Dim StartTime#, CurrentTime#

With Application
'disable the ESC key
.EnableCancelKey = xlDisabled
.ScreenUpdating = False

Call UnhideSheets

.ScreenUpdating = True
're-enable ESC key
.EnableCancelKey = xlInterrupt
End With
'*****************************************
'SET YOUR OWN TRIAL PERIOD BELOW
'Integers (1, 2, 3,...etc) = number of days use
'1/24 = 1Hr, 1/48 = 30Mins, 1/144 = 10Mins use

Const TrialPeriod# = 365 '< 1 year trial
'set your own obscure path and file-name
Const ObscurePath$ = "C:\"
Const ObscureFile$ = "TestFileLog.Log"
'*****************************************
If Dir(ObscurePath & ObscureFile) = Empty Then
StartTime = Format(Now, "#0.#########0")
Open ObscurePath & ObscureFile For Output As #1
Print #1, StartTime
UserForm1.Show
Else
Open ObscurePath & ObscureFile For Input As #1
Input #1, StartTime
CurrentTime = Format(Now, "#0.#########0")
If CurrentTime < StartTime + TrialPeriod Then

Close #1
UserForm1.Show
Exit Sub
Else
If [A1] <> "Expired" Then
MsgBox "Sorry, your trial period has expired - your data" & vbLf & _
"will now be extracted and saved for you..." & vbLf & _
"" & vbLf & _
"This workbook will then be made unusable."
Close #1
SaveShtsAsBook
[A1] = "Expired"
ActiveWorkbook.Save
Application.Quit
ElseIf [A1] = "Expired" Then
Close #1
Application.Quit
End If
End If
End If
Close #1
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(2).[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



and module 11 looks like this:
Sub SaveShtsAsBook()
Dim Sheet As Worksheet, SheetName$, MyFilePath$, N&
MyFilePath$ = ActiveWorkbook.Path & "\" & _
Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 4)
With Application
.ScreenUpdating = False
.DisplayAlerts = False
On Error Resume Next '<< a folder exists
MkDir MyFilePath '<< create a folder
For N = 1 To Sheets.Count
Sheets(N).Activate
SheetName = ActiveSheet.Name
Cells.Copy
Workbooks.Add (xlWBATWorksheet)
With ActiveWorkbook
With .ActiveSheet
.Paste
.Name = SheetName
[A1].Select
End With
'save book in this folder
.SaveAs Filename:=MyFilePath _
& "\" & SheetName & ".xls"
.Close SaveChanges:=True
End With
.CutCopyMode = False
Next
End With
Open MyFilePath & "\READ ME.log" For Output As #1
Print #1, "Thank you for trying out this product."
Print #1, "If it meets your requirements, call"
Print #1, "NBQ Quality Consulting on +2711 914 2274 to purchase"
Print #1, "the full (unrestricted) version..."
Close #1
End Sub


However, when I do this, then I get an error on opening the workbook "Path/File access error" and then debug takes me to "Userform1.show".
I am pretty sure that it is because the user forms have not been loaded yet, but I don't know much. Do I need to put the "userform1.show" somewhere else in the workbook.
Thanks for your help.
Cheers
Lee

GTO
10-21-2008, 01:17 PM
Hi Lee,

No problem whatsoever in taking a gander, there are many here who enjoy assisting.

As to the Path/File access error, in my limited experience, this seems to usually be a harmless but weird little glitch where compilation fails for some reason. Usually I have been able to save the wb, close and reopen, and everything is fine. Again, this is in my limited experience, but give that a try.

I do not believe it is anything to do with userform.show, as we didn't change the order of anything yet. (FYI - the userform automatically loads when .Show is invoked).

I don't see any difference, but just in case, here's a copy of the wb, with the auto_open deleted.

Also - my apologies, but I may or may not be on the forum for the next couple of days, as my truck has developed a major personality disorder... (L480E HD transmission appears to be fatal...). I will check the thread though when I can.

Thanks,

Mark

nbqleebarnes
10-21-2008, 09:45 PM
Hi Mark,
Just dragged myself out of bed, Sorry to hear about your transmission, what I know about cars is even less than VBA, which is not that much, although I am learning a lot with thanks to you. Not a problem if your busy, there is no real rush, and I would like to learn correct ways of writing code.
Anyway I took a look at the wb you attached, and for some reason yours works and mine doesn't, but not a problem, I have them both saved and I have looked through the code, I don't see any obvious differences, but saying this I am sure that you would have some additional suggestions for the code and maybe give me a hand with how I make the passwords for user and admin work properly, when the user logs on the code for deleting the formulas is activated and when the admin logs on then this code is ignored.
Once again, thanks for your help.
Cheers
Lee
P.S. I am trying in the mean time to get the code working.

nbqleebarnes
10-26-2008, 12:36 AM
Hi all,
Been out of town for last few days, could anyone give me hand with this one, as I am trying to get the two passwords to work correctly.
Thanks
Lee

GTO
10-26-2008, 08:17 AM
Hello Lee,

I forgot about this for a bit, sorry about that.

Reference the attached, while trying to leave most of the code as-is, so that its not so different you can't tell what all is modified... I did change the following for your consideration:

In the code module for what was "UserForm1", which I replaced with
"frmPWord_AccessLevel", I eliminated some duplication of making sheets visible, as well as added a UserForm_QueryClose event to disable the form's dismiss button (the "X" button).

In the sheets' modules, I deleted, or more accurately, moved the 'SheetIsProtected' to Module11 and call it from the Workbook event: Workbook_SheetChange

In ThisWorkbook.UnhideSheets, I added a line to leave Sheet("FAD") hidden.

Probably one or two other tiny tweaks; hopefully I commented code well enough.

This should fix the issue of the password userform.

Mark

nbqleebarnes
10-26-2008, 09:44 PM
Hi Mark,
Thanks for good input on the tidying up of the code, it makes a lot more sense, although when I open the program it gives me a run time error - 62 and tells me that "Input past end of file", and the debug takes me to "Input #1, StartTime". Do you know what this error is about.
Thanks
Lee

GTO
10-26-2008, 11:36 PM
Hi Lee,

I believe you're talking about line 41 of Workbook_Open. I opened the file multiple time and was unable to replicate error.

Are you using the file I sent, or did you copy the information over to another workbook?

To answer your question as to error 62, this means that Input attempted to read past EOF marker. As it only reads the first line, and there's only one value in the TestFile.log, this leaves me a bit baffled.

By chance, did you open the TestFileLog.log file and delete the value?

Try this and let me know: Delete the TestFileLog.log file, then open the workbook twice. The first time should recreate the log file, and the second time should run this same line w/o error.

Mark

nbqleebarnes
10-27-2008, 12:01 AM
Hi Mark,
I opened your version of the w/b, I did find the problem though, I had changed the location of the trial log file from C:/ to C:/Windows ay one time, and this must have confused the macro big time, anyway, after deleting the trial log file in windows the program works perfectly, although if I log in as the user, the formulas are not deleted when I unprotect a sheet and click on the tab, the admin works as it is supposed to.
Thanks
Lee

GTO
10-27-2008, 12:59 AM
Hey Lee,

As to the log file, though not sure why that should have effected anything (It should have just created a new file in C:\), but its fixed, so onto next concern.

If you will read the code along with the comments, you will see that I offered a different way "sensing" if/when the user manages to unprotect the sheet. Rather than wait until the select another sheet and then return to the sheet that they unprotected, I user the change event. This way, if the user gets a sheet unprotected, the first cell he changes a value in fires the procedure to eliminate all the formulas.

Mark

nbqleebarnes
10-27-2008, 01:29 AM
Hi Mark,
Sorry, having a blonde day, I now understand what you have done with the changing of any cell, I have unprotected certain cells for data input and it still works perfectly, with both admin and user doing exactly what I intended, I am very greatful for all your input, I have learnt a great deal.
When the macro runs for the user changing an unprotected cell then a pop up block comes up with "sheetIsProtected ran" , can we make this not appear, I don't need the user or the admin to know that the protection macro ran.
Thanks again
Lee

nbqleebarnes
10-27-2008, 02:37 AM
Hi Mark,
Sorry again having a really blonde day, didn't see your comment in the sheet change macro, I have deleted the msg box and now the wb is working exactly the way I intended.
Thanks again for all your help, I will definately be logging in very often, to see what is new in VBAX, I think it is a great forum with very knowledgable people.
Cheers
Lee
:clap:

GTO
10-27-2008, 02:41 AM
Glad you found the rem/comment, and of course you are welcome.

Have a good day,

Mark