PDA

View Full Version : VBA to Restrict certain usernames.



realrookie
03-01-2015, 04:58 AM
Hello,

Very (extremely) new to VBA. I have tried and googled a lot for this but cannot seem to get anything to work remotely close to what I want (if it is possible).

At work we use a shared workbook for logging tests we perform during the day. The problem is that not everyone has their own user login (e.g. new starters) and they use accounts that all start with "Tester".

Is there a way to lock out any username that starts with "Tester" to prevent using the workbook via VBA? And without typing in every user's name into a sheet.

I did read another post on this forum
/showthread.php?34919-Solved-Restricting-Access-to-Spreadsheet-by-Network-User-Name-ID but it didn't make any sense to me of what did what and what goes where :(

Thank you in advance,

RR

Paul_Hossler
03-01-2015, 07:35 AM
The absolute easiest and therefore the least secure is a sub in the Workbook_Open event. It is easily bypassed, so it depends on how complicated you want to get.

Look at the attached xlsm for example

Ask again if you need some more robust solutions

realrookie
03-02-2015, 03:17 AM
Thank you very much Paul.

This does what I wanted. If possible a little bit more robust, that would be great. I tried adding Test as well:


'sUserName = "TESTER1"
'sUserName = "TEST1"

But this did not seem to accept the Test (not Tester) account.

Bob Phillips
03-02-2015, 03:33 AM
Private Sub Workbook_Open()
Dim sUserName As String
Dim vecExclude As Variant

sUserName = Environ("USERNAME")
vecExclude = Array("Tester1", "Test1", "bob")

If Not IsError(Application.Match(sUserName, vecExclude, 0)) Then

Call MsgBox("SORRY!!!" & vbCrLf & vbCrLf & "But '" & sUserName & "' logons are not allow to use this" & _
vbCrLf & vbCrLf & "The workbook will now close", _
vbCritical + vbOKOnly, "Tester Check")

ThisWorkbook.Close (False)
End If
End Sub

GTO
03-02-2015, 04:08 AM
@XLD:




ThisWorkbook.Close (False)


Why the parenthesis in this case?

Mark

GTO
03-02-2015, 04:10 AM
Sorry, blond and slow witted...

Also, why the Call for the message box?

Mark

Aussiebear
03-02-2015, 04:16 AM
@ Mark, You dyed your mane?

GTO
03-02-2015, 04:19 AM
@ Mark, You dyed your mane?

Not so far at least. Turned 54 last December...

I am afraid the black mane is Malcom's fault!

Mark

realrookie
03-02-2015, 05:00 AM
Why the Call for the message box?

Mark

So that the user knows why they have no access to it.

realrookie
03-02-2015, 05:30 AM
Thank you xld for the code, but it does not seem to have any effect. I copied your code in This.Workbook but with our temporary accounts I can still access the file.

Bob Phillips
03-02-2015, 03:54 PM
@XLD:

Why the parenthesis in this case?

Mark

No idea, that was already in the code, I just copied it.

GTO
03-02-2015, 04:29 PM
@XLD:


ACK! :banghead:

and ...

:oops:

My bad. I think an accurate expression over there would be that I've obviously become a lazy sod and a dullard. I failed to look up and see the original code.

Hope all is well in your corner,

Mark

Paul_Hossler
03-03-2015, 07:13 AM
The marked line looks for TESTER+anything as a user id and exits if it does not start with it (actually "TESTER" in the first 6 char), allowing the workbook to open




Option Explicit
Private Sub Workbook_Open()
Dim sUserName As String

sUserName = UCase(Environ("USERNAME"))

'uncomment out for testing
'sUserName = "TESTER1"

If Left(sUserName, 6) <> "TESTER" Then Exit Sub ' <--------------------------------------

Call MsgBox("SORRY!!!" & vbCrLf & vbCrLf & "But 'Tester' logons are not allow to use this" & _
vbCrLf & vbCrLf & "The workbook will now close", _
vbCritical + vbOKOnly, "Tester Check")
ThisWorkbook.Close (False)
End Sub




If you change it to



If Left(sUserName, 4) <> "TEST" Then Exit Sub



then it will allow the workbook to open if the first 4 char of user id are not TEST

Did you want TEST1 to be allowed to use it, but TESTERxx not?


Another way to look at it is to not use the Exit Sub and just a If / Then



Option Explicit
Private Sub Workbook_Open()
Dim sUserName As String

sUserName = UCase(Environ("USERNAME"))

'uncomment out for testing
sUserName = "TEST1"

If Left(sUserName, 4) = "TEST" Then

Call MsgBox("SORRY!!!" & vbCrLf & vbCrLf & "But 'Tester' logons are not allow to use this" & _
vbCrLf & vbCrLf & "The workbook will now close", _
vbCritical + vbOKOnly, "Tester Check")
ThisWorkbook.Close (False)
End If

End Sub

realrookie
03-03-2015, 07:29 AM
Thank you Paul, that works fine, but now I get an error with Private Sub Workbook_Open() as it appears 2 times. Once for this code and second to start a timer which saves and closes the file after 20min. Which gives me headaches as well now, but that is a different topic.

Paul_Hossler
03-03-2015, 09:17 AM
Well, you only get one WB Open

I didn't follow all of your PM, but I'd expect you want to call SetTime only if the WB actually opens




Option Explicit
Private Sub Workbook_Open()
Dim sUserName As String

sUserName = UCase(Environ("USERNAME"))

'uncomment out for testing
sUserName = "TEST1"

If Left(sUserName, 4) = "TEST" Then

Call MsgBox("SORRY!!!" & vbCrLf & vbCrLf & "But 'Tester' logons are not allow to use this" & _
vbCrLf & vbCrLf & "The workbook will now close", _
vbCritical + vbOKOnly, "Tester Check")

'may be needed ???
Call Disable

ThisWorkbook.Close (False)
End If


'if you get this far then the user id is OK
Call SetTime

End Sub