Is this kind of login possible in VBA? - ms-access

Question

I work on Access Project, but I think there is nothing specific to Access in this question.
I have a form and it's possible to open it only if you are in the table of authenticated users (and I authenticate user by his windows username) - I know it is lame authentication.
Here's the code I've put into form open event:
Private Sub Form_Open(Cancel As Integer)
If DCount("User_Id", "Users", "[username]='" & (Environ$("Username")) & "'") Then
Else
MsgBox "Access Denied!"
DoCmd.Quit
End If
End Sub
What I want to accomplish is that when MsgBox "Access Denied!" is displayed, if I type certain word (something as password) before clicking on OK button, that DoCmd.Quit is not executed. I don't want to display anything, just type in the password.
I don't need this desperately, I just want to make this for fun. And I think it would be really cool if it's possible with VBA.

Answer 1

I tested this in Access 2007 and I think the logic is what you want, or at least it's close. Please consider using something like the WindowsUser() function below to get the Windows user name. I get that this is just for fun, so you don't care now. However, keep this point in mind for anything you do care about in the future. Environ("USERNAME") as a security measure is trivially easy to defeat.
Const cstrYourPassword As String = "let me in"
Dim blnGoodbye As Boolean
Dim lngButtons As Long
Dim strPrompt As String
Dim strPassword As String
strPrompt = "Access Denied!" & vbCrLf & vbCrLf & _
"Click Retry to try with password" & vbCrLf & _
"or Cancel to quit."
lngButtons = vbCritical + vbRetryCancel
If MsgBox(strPrompt, lngButtons) = vbRetry Then
strPassword = InputBox("Password:")
If strPassword = cstrYourPassword Then
MsgBox "Welcome " & WindowsUser
Else
blnGoodbye = True
End If
Else
blnGoodbye = True
End If
If blnGoodbye = True Then
MsgBox "That's all folks."
'DoCmd.Quit ' <- enable this when ready.
End If
Use this instead of Environ("USERNAME").
Public Function WindowsUser() As String
Static strUserName As String
If Len(strUserName) = 0 Then
strUserName = CreateObject("WScript.Network").Username
End If
WindowsUser = strUserName
End Function

Answer 2

The following should work, but you may want to modify it to set the password to something better or if you want more than one password. Anyone who knows how to read the code will be able to find out the password as well, so maybe it would be better to put it in the database somewhere?
Const sPassword As String = "PASSWORD"
Const sMESSAGE As String = "Please enter your password"
Const sTITLE As String = "Enter Password"
Dim sInput As String
sInput = InputBox(sMESSAGE, sTITLE)
If sInput <> Password Then
MsgBox "Access Denied!"
DoCmd.Quit
End If