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
@XLD:
ThisWorkbook.Close (False)
Why the parenthesis in this case?
Mark
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?
@ 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.
@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
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.