VBA to Restrict certain usernames.

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

Code:

---

/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

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

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:

Code:

---

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

---

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

Code:

---

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:

Quote:

---

Originally Posted by xld

Code:

---

        ThisWorkbook.Close (False)

---

---

Why the parenthesis in this case?

Mark

Sorry, blond and slow witted...

Also, why the Call for the message box?

Mark

@ Mark, You dyed your mane?

Quote:

---

Originally Posted by Aussiebear

@ 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

Quote:

---

Originally Posted by GTO

Why the Call for the message box?

Mark

---

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

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.

Quote:

---

Originally Posted by GTO

@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

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

Code:

---

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

Code:

---

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

Code:

---

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

---

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.

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

Code:

---

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

---