Give only named users acces

Hello,
is it possible, with a vba code, that a sheet only opens if a registered user tries to open a sheet. All these users must have full acces to the sheet.

We work in a network and every user is known in the system by firtsname.lastname.

So before excell opens the sheet there must be a check if the user is permitted to open it.

Because passwords can be simply removed i liked this kind of protection.

Ger

One of the issues is that the user must have macor security set to low for this to take place, you'd have to hid all sheets programatically and used xlveryhidden, this way the user cannot unhide a sheet using the user interface regardless of whether they have macros enabled or not.

So lets say you have a sheet call Names to house the names of the users and a sheet called welcome, column A of the worksheet "names" will house the usernames[vba]Private Sub Workbook_BeforeClose(Cancel As Boolean)
For Each sh In Sheets
If sh.Name = "Welcome" Then
sh.Visible = xlSheetVisible
Else
sh.Visible = xlSheetVeryHidden
End If
Next sh
End Sub
Private Sub Workbook_Open()
Dim sh As Worksheet
Dim rng As Range
Set rng = Sheets("Names").Range("A1:A" & Sheets("Names").Range("A" & Rows.Count).End(xlUp).Row)
If Application.WorksheetFunction.CountIf(rng, Application.Environ("username")) > 0 Then
For Each sh In Sheets
If sh.Name = "Welcome" Or sh.Name = "Names" Then
Else
sh.Visible = xlSheetVisible
End If
Next sh
End If
sheets("Welcome").visible = xlsheetveryhidden
End Sub[/vba]I haven't tested this as i've just written it here off the cuff but should be good to go.

The above code goes in the thisworkbook code module.

I tried your code. I get an error by saving on
sh.Visible = xlSheetVeryHidden

by opening i get an error on
If Application.WorksheetFunction.CountIf(rng, Application.Environ("username")) > 0 Then


PS how can i unhide the sheet welcome and names "manually"

Ger

See the attached, all you need to do is add your name to the Names sheet (your login name that is) and then uncomment all the code in the thisworkbook code module.

When sheets are hidden as veryhidden you cannot manually unhide them, you can only unhide them by code, i've added a module to unhide all of them for you.

Simon,

i tried your example. I get the login name using this code.


[VBA]
Sub GetTheNameAPP()
MsgBox "Application username is: " & Application.UserName
End Sub
[/VBA]
and also tried this code

[VBA]Private Sub Workbook_Open()
Open "C:\Gebruikers test.log" For Append As 1
Print #1, "Geopend CW", Now, Environ("USERNAME")
Close #1
[/VBA]
i get the same name but in a different way (firstname.lastname and lastname, firstname initials (company))
I tried both on the sheet names.
but the sheet welcome stays hidden.

Ger

Application.Username is the name that the user gives themselves on the pc, Environ("username") gets you the windows login name.

If the welcome sheet is staying hidden then it's because your name appears in the list, however substitute this code in the thisworkbook code module[VBA]Private Sub Workbook_BeforeClose(Cancel As Boolean)
Sheets("Welcome").Visible = xlSheetVisible
For Each sh In Sheets
If sh.Name <> "Welcome" Then
sh.Visible = xlSheetVeryHidden
End If
Next sh
ThisWorkbook.Saved = True
End Sub
Private Sub Workbook_Open()
Dim sh As Worksheet
Dim rng As Range
Set rng = Sheets("Names").Range("A1:A" & Sheets("Names").Range("A" & Rows.Count).End(xlUp).Row)
If Application.WorksheetFunction.CountIf(rng, Environ("username")) > 0 Then
For Each sh In Sheets
If sh.Name = "Welcome" Or sh.Name = "Names" Then
Else
sh.Visible = xlSheetVisible
End If
Next sh
End If
Sheets("Welcome").Visible = xlSheetVeryHidden
End Sub[/VBA]