How to create and manage user access
I am trying to create a system to manage user access in VBA.
I have a login form with a login script, I have a logout script but I would also like the possibility to store settings and preferences.
Users is a worksheet with column B for username, column C for the password, column D for admin (admin = TRUE, not admin = FALSE).
I want to make sure that an user can't get access to my file without having a username and a password.
At the moment I only have settings for toggle fullscreen that I would like to save between user sessions but I am thinking about the possibility to hide/show worksheets based on user level or admin level.
How can I improve this code? I would like to create a framework in some way that connects with my other code which is lots of small subs. I have an userform that allows me to hide or show worksheets and I would like to connect that userform to my framework if possible?
Code:
Public check As Boolean
Private Sub LogIn_Click()
'Dim username As String
Dim Password As String
Dim passWs As Worksheet
Dim lRow As String
Dim rng As range
Dim CorrectDetails As Boolean
Dim i As Integer
Username = Me.Username.Value
Password = Me.Password.Text
If Len(Trim(Username)) = 0 Then
Me.Username.SetFocus
MsgBox "Please enter your username", vbOKOnly, "Username"
Exit Sub
End If
If Len(Trim(Password)) = 0 Then
Me.Password.SetFocus
MsgBox "Please enter your password", vbOKOnly, "Password"
Exit Sub
End If
Set passWs = ThisWorkbook.worksheets("Users")
With passWs
lRow = .range("B" & .Rows.Count).End(xlUp).Row
For i = 1 To lRow
If UCase(Trim(.range("B" & i).Value)) = UCase(Trim(Username)) Then 'Username Check
If .range("C" & i).Value = Password Then 'Password Check
CorrectDetails = True
'Sheets("Start").Activate
' Admin is True
Sheets("Admin").Visible = True
Sheets("Admin").Activate
check = True
If Username.Value <> "" Then
On Error Resume Next
Sheets("Start").Shapes("LoggedIn").TextFrame.Characters.Text = "Logged In as " & Username.Value
End If
Me.Hide
Unload Me
If .range("D" & i).Value = "True" Then
End If
'Admin is false
Else
Sheets("Start").Activate
check = True
If Username.Value <> "" Then
On Error Resume Next
Sheets("Start").Shapes("LoggedIn").TextFrame.Characters.Text = "Logged In as " & Username.Value
End If
Unload Me
End If
Exit For
End If
End If
Next i
'Incorrect Username/Password
If CorrectDetails = False Then
MsgBox "Wrong username and/or password"
End If
End With
End Sub
Private Sub Close_Click()
'Unloads the form
check = True
Unload Me
ActiveWorkbook.Close True
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If check = False Then
MsgBox "Please enter your username and password", vbCritical
Cancel = True
End If
End Sub
Code:
Sub LogOut()
Dim result As String
result = MsgBox("Hi, " & Application.Username & " Save and exit?", vbYesNo + vbQuestion)
If result = vbYes Then ' Logs out user
On Error Resume Next
Sheets("Start").Shapes("LoggedIn").TextFrame.Characters.Text = "Logged In as "
On Error Resume Next
ActiveWorkbook.Save
ActiveWorkbook.Close , True
Else:
End If
End Sub
Code:
Sub ToggleFullScreeen()
Application.DisplayFullScreen = Not Application.DisplayFullScreen
With Application.ActiveWindow
.DisplayHeadings = Not .DisplayHeadings
.DisplayWorkbookTabs = Not .DisplayWorkbookTabs
End With
End Sub
