Solved: Restricting Access to Spreadsheet by Network User Name/ID

[Panda]

Hi There,

I have a spreadsheet that only certain people should be able to access. Is there a (VBA) way to get excel to check the user ID against a list of user names/id already contained within the spreadsheet. With the spreadsheet opening if the user name is there and denying access is the user name isnt there?

Thanking you in advance

Phil

[p45cal]

Where are you getting the user's ID from?
There are several possibilities:
environ("Username")
gives the id of the logged on user
application.username
gives the name of he user of the application (Excel) as found in the Options.
Or are you asking for an input from the user?

In any event, you could use the result of the above in a bit of code in the
Private Sub Workbook_Open()
event, say:
if iserror(Application.VLookup(Environ("Username"),Range("$I$13:$I$17"),1,false)) then thisworkbook.close or some such. It's a bit basic because a user could easily disable macros.
A work around for that is to xlveryhidden all but an unimportant sheet in the workbook, password protect the code, of course (it's still fairly easy to break - it depends on how determined the user is to break through).

I think there may be an article at ozgrid.com but that site isn't playing at the moment.
This isn't an uncommon request and some googling should help too.

[Panda]

Where are you getting the user's ID from?
There are several possibilities:
environ("Username")
gives the id of the logged on user
application.username
gives the name of he user of the application (Excel) as found in the Options.
Or are you asking for an input from the user?

In any event, you could use the result of the above in a bit of code in the
Private Sub Workbook_Open()
event, say:
if iserror(Application.VLookup(Environ("Username"),Range("$I$13:$I$17"),1,false)) then thisworkbook.close or some such. It's a bit basic because a user could easily disable macros.
A work around for that is to xlveryhidden all but an unimportant sheet in the workbook, password protect the code, of course (it's still fairly easy to break - it depends on how determined the user is to break through).

I think there may be an article at ozgrid.com but that site isn't playing at the moment.
This isn't an uncommon request and some googling should help too.
Hi Thanks for the reply. I am using the code below;

Public Declare Function GetUserName Lib "advapi32.dll" _
Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long

Function ReturnUserName() As String
' returns the NT Domain User Name
Dim rString As String * 255, sLen As Long, tString As String
tString = ""
On Error Resume Next
sLen = GetUserName(rString, 255)
sLen = InStr(1, rString, Chr(0))
If sLen > 0 Then
tString = Left(rString, sLen - 1)
Else
tString = rString
End If
On Error GoTo 0
ReturnUserName = UCase(Trim(tString))
End Function

and then recording a macro of myself typing in =ReturnUserName() into a cell.

I know its not the best way but I am trying to teach myself VBA by having a go.

Thanks again for your help

[p45cal]

in that case:
If iserror(ReturnUserName,Range("$I$13:$I$17"),1,False)) Then thisworkbook.close I suspect your ReturnUserName function will return the same as Environ("Username"), except that your function changes it to all upper case.
Range("$I$13:$I$17") is the list of names which are approved. It would probably be better to qualify it with a sheet name:
Sheets("mySheet").Range("$I$13:$I$17")
or even more qualification with:
ThisWorkbook.Sheets("mySheet").Range("$I$13:$I$17")

[Panda]

Thanks how do I assign the code;


If iserror(ReturnUserName,Range("$I$13:$I$17"),1,False)) Then thisworkbook.close

to the workbook so that it executes upon opening. Sorry i am probebly asking really basic questions but I do appreciate your time getting back to me =:)

[Kenneth Hobs]

In this method, I added a Main page for an information page to show when their username was not found in the Users page starting starting at A2.

Put this code in the ThisWorkbook object. Password protect your vbaproject.

The last 2 subs makes it easy to hide or unhide the Users sheet. You can do that in the Properties in the VBE easily though.

Option Explicit
Private UsersSheet As String
Private MainSheet As String
Private Sub Workbook_Open()
Dim r As Range
UsersSheet = "Users"
MainSheet = "Main"
Set r = Worksheets(UsersSheet).Range("A:A").Find(What:=Environ("username"), After:=Range("A1"), _
LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If Not r Is Nothing Then HideSheets False
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
HideSheets True
End Sub

Private Sub HideSheets(tf As Boolean)
Dim sh As Worksheet
If tf Then
For Each sh In Worksheets
If sh.Visible = xlSheetVisible And sh.Name <> MainSheet Then _
sh.Visible = xlSheetVeryHidden
Next sh
Else
For Each sh In Worksheets
If Not sh.Name = "Users" Then sh.Visible = xlSheetVisible
Next sh
End If
End Sub

Private Sub UnHideUsersSheet()
Worksheets(UsersSheet).Visible = xlSheetVisible
End Sub

Private Sub HideUsersSheet()
Worksheets(UsersSheet).Visible = xlSheetVeryHidden
End Sub

[p45cal]

Thanks how do I assign the code;


If iserror(ReturnUserName,Range("$I$13:$I$17"),1,False)) Then thisworkbook.close

to the workbook so that it executes upon opening. Sorry i am probebly asking really basic questions but I do appreciate your time getting back to me =:)

In the vbe, in the Project Explorer pane (on the left) look for the ThisWorkbook belonging to the workbook you're wanting this code to be in. Right click it and choose View Code. At the top of the pane on the right (where you normally put code, you'll see two dropdowns, choose Workbook from the left one and Open from the right one. Now paste/write the code below the line:
Private Sub Workbook_Open()
Make sure your username is in the list! Save the workbook. Close it. Open it. It should open without problem. Remove or adjust your name in the list, save and close it. Open it. It should close immediately when you try to open it if you enable macros. Open it without enabling macros to readjust your name in the list, then save. Of course you don't have to close the workbook, you could just not unhide sheets, or pop up a message etc. etc.

[Panda]

In this method, I added a Main page for an information page to show when their username was not found in the Users page starting starting at A2.

Put this code in the ThisWorkbook object. Password protect your vbaproject.

The last 2 subs makes it easy to hide or unhide the Users sheet. You can do that in the Properties in the VBE easily though.

Option Explicit
Private UsersSheet As String
Private MainSheet As String
Private Sub Workbook_Open()
Dim r As Range
UsersSheet = "Users"
MainSheet = "Main"
Set r = Worksheets(UsersSheet).Range("A:A").Find(What:=Environ("username"), After:=Range("A1"), _
LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If Not r Is Nothing Then HideSheets False
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
HideSheets True
End Sub

Private Sub HideSheets(tf As Boolean)
Dim sh As Worksheet
If tf Then
For Each sh In Worksheets
If sh.Visible = xlSheetVisible And sh.Name <> MainSheet Then _
sh.Visible = xlSheetVeryHidden
Next sh
Else
For Each sh In Worksheets
If Not sh.Name = "Users" Then sh.Visible = xlSheetVisible
Next sh
End If
End Sub

Private Sub UnHideUsersSheet()
Worksheets(UsersSheet).Visible = xlSheetVisible
End Sub

Private Sub HideUsersSheet()
Worksheets(UsersSheet).Visible = xlSheetVeryHidden
End Sub

Thanks but I cant seem to get it to work, do I need to run this code in conjunction the the =ReturnUserName() function that I posted earlier in the thread?

Ideally I am trying to get excel to check the network user name of the user compare it to a list within the workbook and then either allow or deny access based on whether their user name is on the list or not. The end users of the spreadsheet do not have any knowledge of VBA so although it is a primitive way if restricting access it will work.

Thanks for your help so far =:)

[Jan Karel Pieterse]

Why don't you simply put the workbook in question in a network folder and only give the people needing access the proper rights to that folder?

[Panda]

Why don't you simply put the workbook in question in a network folder and only give the people needing access the proper rights to that folder?

Oh yeah....thinking outside of the box...that is a much better idea!!! Although now I am a bit intrigued and will try to get it working lol

[Panda]

OK so I have had at setting up this spreadsheet, but I get an 'Type Mis-match' error.

Below is the code that I have put into the 'this workbook' module;


Private Sub Workbook_Open()
ActiveCell.FormulaR1C1 = "=ReturnUserName()"
Range("$A$2").Select
If Range("A2") <> Sheets("Users").Range("$A$2:$A$10") Then
ThisWorkbook.Close
End If
End Sub

and this is the code that I have put into a new module (Module 1)


Public Declare Function GetUserName Lib "advapi32.dll" _
Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Function ReturnUserName() As String
' returns the NT Domain User Name
Dim rString As String * 255, sLen As Long, tString As String
tString = ""
On Error Resume Next
sLen = GetUserName(rString, 255)
sLen = InStr(1, rString, Chr(0))
If sLen > 0 Then
tString = Left(rString, sLen - 1)
Else
tString = rString
End If
On Error GoTo 0
ReturnUserName = UCase(Trim(tString))
End Function

I am trying to get the code to check the username that is in Cell A1 of one sheet against all the user names listed in Column A1:A10, if it is there then open the file, if not then close it.

Any help will be greatly appreciated

Thanks

Phil

[Kenneth Hobs]

When you say not working, I am not sure what that means.

Obviously, you would need to add the usernames to the Users sheet.

You can use the Environ method or your method. For your method, add your routine to a Module. Then replace the Set line with:
Set r = Worksheets(UsersSheet).Range("A:A").Find(What:=ReturnUserName(), After:=Range("A1"), _
LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)

[Panda]

With the code that i have used when I open the spreadsheet, the macro fails to execute properly instead displaying a 'Run-time error 13 Type mismatch'.

How do I incorporate the code that you sugessted into what I already have entered?


Set r = Worksheets(UsersSheet).Range("A:A").Find(What:=ReturnUserName(), After:=Range("A1"), _
LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
Thanks

Phil

[Kenneth Hobs]

You don't. Use my code for my code.

Using your method, the users can open your workbook if they set the security to bypass macro code.

Even with my code, one should add passwords so that if they strip the vba code, the hidden sheets will still be protected.

[Panda]

Oh I see, it works a treat =:)

Just one more thing I promise, how do I unhide the 'Users' sheet by using VBE properties as currently when I want to add a user I go into the code enter the password and cycle through the 'HideUserSheet' sub in order to make it appear again.

Sorry Im a bit of a VBA novice

thanks for all your help though =:)

[Kenneth Hobs]

If you password protected the vbaproject, you will have to add the password to open the project. In the Properties view, you can set it there or run the macro.

If you want to keep it protected, add the hide and unhide routines to your personal workbook and run from there.

[Panda]

Thank you so much, I have finally got my head in order and it works a treat.

Hopefully one day I will have learnt enough to help someone else out instead of being the one constantly asking for help.

Thanks again for your time =:)