Force read only based on user

[gbell3587]

Hi

We have a shared workbook but only 2 people should be allowed to edit it......its very annoying when someone goes in with full control and not read only. Is there anyway to force read only based on username? e.g if user is Tom, the workbook will open as read only but if user is Mike then it will open with full access?

I know you can suggest read only, but ideally i would like a bit of code to force it.

Cheers
Graham

 

[lenze]

can not you require a password for Edit access???
lenze

 

[gbell3587]

can not you require a password for Edit access???
lenze

Hi

Ive actually found a way to do this......for anyone out there whos looking to do the same, here is my code

Sub Workbook_Open()
    Select Case Application.UserName
    Case "Graham"
    GoTo bypass
    Case "Joe"
    GoTo bypass
    Case Else
    msg = MsgBox("Hi " & Application.UserName & vbNewLine & vbNewLine & "Write permissions reserved for Graham & Joe, document will now switch to Read only.", vbInformation + vbOKOnly, "Permissions")
    If Not ActiveWorkbook.ReadOnly Then ActiveWorkbook. _
        ChangeFileAccess Mode:=xlReadOnly
bypass:
    End Select
End Sub

This checks the username and if its not Graham or Joe, it will display a message box saying the document is going in to read only & does this.


Thanks
Graham

 

[Smitty]

We have a shared workbook but only 2 people should be allowed to edit it......its very annoying when someone goes in with full control and not read only.

Then it's not truly a shared workbook right? It's just one that multiple people have access to?

You can certainly change the Read/Write status, but you can't overcome the precedence of who opens it first.

Here's an example of changing the status:

<font face=Calibri><SPAN style="color:#00007F">Sub</SPAN> SetAsReadOnly()<br>    <SPAN style="color:#007F00">'   Test for PC User Name</SPAN><br>    <SPAN style="color:#00007F">Dim</SPAN> strUser <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN><br>        strUser = Environ("USERNAME")<br>        <SPAN style="color:#007F00">'   MsgBox strUser</SPAN><br>        <br>     <SPAN style="color:#007F00">'  Set Read only File Access for each Office's specific version</SPAN><br>    <SPAN style="color:#00007F">Select</SPAN> <SPAN style="color:#00007F">Case</SPAN> strUser<br>        <SPAN style="color:#007F00">'   Full Workbook Access</SPAN><br>        <SPAN style="color:#00007F">Case</SPAN> <SPAN style="color:#00007F">Is</SPAN> = "YourUserName", "AnotherUser"<br>            <SPAN style="color:#00007F">If</SPAN> ActiveWorkbook.ReadOnly Then _<br>                ActiveWorkbook.ChangeFileAccess Mode:=xlReadWrite, WritePassword:="admin"<br>        <SPAN style="color:#007F00">'   Limit Access</SPAN><br>        <SPAN style="color:#00007F">Case</SPAN> <SPAN style="color:#00007F">Is</SPAN> <> "YourUserName"<br>            <SPAN style="color:#00007F">If</SPAN> <SPAN style="color:#00007F">Not</SPAN> ActiveWorkbook.ReadOnly Then _<br>                ActiveWorkbook.ChangeFileAccess Mode:=xlReadOnly, WritePassword:="admin"<br>    <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Select</SPAN><br><br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN></FONT>

HTH,

 

[gbell3587]

Then it's not truly a shared workbook right? It's just one that multiple people have access to?

You can certainly change the Read/Write status, but you can't overcome the precedence of who opens it first.

Here's an example of changing the status:

Sub SetAsReadOnly()
' Test for PC User Name
Dim strUser As String
strUser = Environ("USERNAME")
' MsgBox strUser

' Set Read only File Access for each Office's specific version
Select Case strUser
' Full Workbook Access
Case Is = "YourUserName", "AnotherUser"
If ActiveWorkbook.ReadOnly Then _
ActiveWorkbook.ChangeFileAccess Mode:=xlReadWrite, WritePassword:="admin"
' Limit Access
Case Is <> "YourUserName"
If Not ActiveWorkbook.ReadOnly Then _
ActiveWorkbook.ChangeFileAccess Mode:=xlReadOnly, WritePassword:="admin"
End Select

End Sub

HTH,

Thanks for this code.

Yeah its just a workbook that many people use,. Can you clafiry the 'you can't overcome the precedence of who opens it first.' comment - wont my code work for this? lets say harry opens the work book, it will switch him to read only so that when the next person - Graham or Joe opens it, it will be in read/write access, wont this be the case?!

Graham

 

[Smitty]

Sorry for posting the code after you already posted yours, but I had started to respond, then walked away for a bit.

As for clarification, yes, in theory you can lock users out with the Read-Only change and the next person with Write access to open it should have it, but I mentioned it because you can't account for network issues/user name variances, etc. - there all kings of things that can go wrong...

You may want to look at Microsoft's new cloud based SkyDrive option, which does allow simultaneous editing, and you can set folder permissions for Read/Write access: http://explore.live.com/office-web-apps-excel-work-together-using

I haven't had much time to play with it, but it seems pretty promising.

 

[gbell3587]

Awesome, thanks for the link.......i'll check it out, simultaneous editing is definetly something i want to implement. Yeah i know my code isnt full proof, but it should be ok for my needs, will have to wait till im back in office in the morning to properly put it to the test.

Thanks for your help.

 

[PureBluff]

Apologies for bumping an old thread, assuming I applied this using write access for 5 users, would it be possible to prompt for a password if a user is not on the authorised list.... Permitting them to have write access should the pwd be correct.

I'd also then aim to make the password a variable, say, =today() + x based on weekday to create a basic level of security. -- I could do this bit with ease providing the former was possible

 

[PureBluff]

Sub Workbook_Open()

 Dim pwd As String
 On Error GoTo errhdl:
    
    pwd = Format(Now() + 3, "ddmmyy")
    Select Case Application.UserName
    Case "PureBluff"
    GoTo bypass
    Case "OtherUser"
    GoTo bypass
    Case Else
    response = InputBox("Hi " & Application.UserName & vbNewLine & vbNewLine _
    & "Write permissions reserved for Authorised Users, please input password or document will switch to Read only.", _
    vbInformation + vbOKOnly, "Permissions")
     
    
    If response <> pwd Then ActiveWorkbook.ChangeFileAccess Mode:= _
        xlReadOnly
bypass:
    End Select
errhdl:
    Exit Sub
End Sub

Seems to work, just need to add a slighly more rando. password algo/