VBA to Restrict certain usernames.

[realrookie]

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]

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]

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]

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]

@XLD:

        ThisWorkbook.Close (False)

Why the parenthesis in this case?

Mark

[GTO]

Sorry, blond and slow witted...

Also, why the Call for the message box?

Mark

[Aussiebear]

@ Mark, You dyed your mane?

[GTO]

@ 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]

Why the Call for the message box?

Mark

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

[realrookie]

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]

@XLD:

Why the parenthesis in this case?

Mark

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

[GTO]

@XLD:


ACK!

and ...



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]

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]

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]

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