I have this Code on a Login screen to an access database.....The Login works as expected...My only issue is i have to click on the OK button twice for the login process vs a one click.....Cant figure out whats going on...any assistance will be greatly appreciated.
------------------------------------------
Option Compare Database
Option Explicit
Public message1 As String
'ENABLE FULL DB SECURITY IF CANCEL IS CLICKED AT LOGIN
Private Sub Command0_Click()
'Dim prop As dao.Property
' Dim db As dao.Database
'On Error GoTo SetProperty
' Set prop = currentdb.CreateProperty("AllowBypassKey", dbBoolean, False)
' currentdb.Properties.Append prop
'SetProperty:
'currentdb.Properties("AllowBypassKey") = False
DoCmd.RunCommand acCmdExit
Quit acQuitSaveAll
End Sub
'*************LOGIN SCRIPT************
Private Sub Command1_Click()
Dim UserLevel As String
If IsNull(Me.txtloginid) Then
MsgBox "Please Select LoginID", vbInformation, "LoginID Required"
Me.txtloginid.SetFocus
ElseIf IsNull(Me.txtPassword) Then
MsgBox "Please Enter Password", vbInformation, "Password Required"
Me.txtPassword.SetFocus
Else
'***PROCESS THIS JOB IF THE LOGIN IS CORRECT*****
If (IsNull(DLookup("userlogin", "tbluser", "userlogin ='" & Me.txtloginid.Value & "'And Password = '" & Me.txtPassword.Value & "'"))) Then
MsgBox "Incorrect Password for this Login ID"
Else
UserLevel = DLookup("usersecurity", "tbluser", "userlogin = '" & Me.txtloginid.Value & "'")
PWRESET = DLookup("pwreset", "tbluser", "userlogin = '" & Me.txtloginid.Value & "'")
Forms![login].Visible = False
'***RUN THIS IF THE USER IS ADMIN****
If UserLevel = "Admin" Then
DoCmd.OpenForm "Splash_Admin"
'***Prompt option to enable/disable bypass key....takes effect after restart***
Dim prop As dao.Property
Dim db As dao.Database
On Error GoTo SetProperty
Set prop = currentdb.CreateProperty("AllowBypassKey", dbBoolean, False)
currentdb.Properties.Append prop
SetProperty:
If MsgBox("***ENABLE SECURITY BYPASS OPTION ?***", vbYesNo, "Allow Bypass?") = vbYes Then
currentdb.Properties("AllowBypassKey") = True
Else
currentdb.Properties("AllowBypassKey") = False
End If
'****RUN THIS IF THE PROFILE IS NOT ADMIN*****
Else
If UserLevel = "User" Then
DoCmd.OpenForm "Splash_User"
DoCmd.ShowToolbar "Ribbon", acToolbarNo
If Me.PWRESET = True Then
DoCmd.OpenForm "PasswordResetForm"
End If
Else
If UserLevel = "Reporting" Then
DoCmd.OpenForm "Splash_Reporting"
DoCmd.ShowToolbar "Ribbon", acToolbarNo
If Me.PWRESET = True Then
DoCmd.OpenForm "PasswordResetForm"
End If
End If
End If
End If
End If
End If
End Sub
Private Sub Form_Load()
Me.txtloginid.SetFocus
'DoCmd.ShowToolbar "Ribbon", acToolbarNo
Dim myQry As String
Dim sUserName As String
Dim sUserPC As String
' Get Current User Name
sUserName = Environ$("computername")
sUserPC = Environ$("username")
' If you want Computer Name use Environ$("computername") OR ("Username")
'myQry = "INSERT INTO tblLogUserAccess (logUser, logDate) VALUES ('" & sUserName & "',#" & Now() & "#)"
Me.CompUser = sUserName
Me.compname = sUserPC
'currentdb.Execute myQry
End Sub
Private Sub Form_Open(Cancel As Integer)
Database is restricted <--- "
'message = " Welcome To Test "
End Sub
Private Sub Form_Timer()
ownerinfo = message1
'Get first character
Dim FChar As String
FChar = Left(message1, 1)
'Remove first character
message1 = Mid$(message1, 2, Len(message1) - 1)
'Put 1st character at the end of the message.
message1 = message1 + FChar
Me.Auto_Time = Format(Time, "HH:MM:SS AM/PM")
End Sub
Private Sub txtloginid_AfterUpdate()
'GROUP = DLookup("group", "[tbluser]", "[TECH NAME]= '" & [txtloginid] & "'")
Me.txtPassword.SetFocus
End Sub
Private Sub txtloginid_Change()
Me.txtPassword = ""
End Sub
Private Sub txtPassword_AfterUpdate()
'Me.Command1.SetFocus
End Sub
Private Sub txtPassword_Exit(Cancel As Integer)
Me.Command1.SetFocus
End Sub
------------------------------------------
Option Compare Database
Option Explicit
Public message1 As String
'ENABLE FULL DB SECURITY IF CANCEL IS CLICKED AT LOGIN
Private Sub Command0_Click()
'Dim prop As dao.Property
' Dim db As dao.Database
'On Error GoTo SetProperty
' Set prop = currentdb.CreateProperty("AllowBypassKey", dbBoolean, False)
' currentdb.Properties.Append prop
'SetProperty:
'currentdb.Properties("AllowBypassKey") = False
DoCmd.RunCommand acCmdExit
Quit acQuitSaveAll
End Sub
'*************LOGIN SCRIPT************
Private Sub Command1_Click()
Dim UserLevel As String
If IsNull(Me.txtloginid) Then
MsgBox "Please Select LoginID", vbInformation, "LoginID Required"
Me.txtloginid.SetFocus
ElseIf IsNull(Me.txtPassword) Then
MsgBox "Please Enter Password", vbInformation, "Password Required"
Me.txtPassword.SetFocus
Else
'***PROCESS THIS JOB IF THE LOGIN IS CORRECT*****
If (IsNull(DLookup("userlogin", "tbluser", "userlogin ='" & Me.txtloginid.Value & "'And Password = '" & Me.txtPassword.Value & "'"))) Then
MsgBox "Incorrect Password for this Login ID"
Else
UserLevel = DLookup("usersecurity", "tbluser", "userlogin = '" & Me.txtloginid.Value & "'")
PWRESET = DLookup("pwreset", "tbluser", "userlogin = '" & Me.txtloginid.Value & "'")
Forms![login].Visible = False
'***RUN THIS IF THE USER IS ADMIN****
If UserLevel = "Admin" Then
DoCmd.OpenForm "Splash_Admin"
'***Prompt option to enable/disable bypass key....takes effect after restart***
Dim prop As dao.Property
Dim db As dao.Database
On Error GoTo SetProperty
Set prop = currentdb.CreateProperty("AllowBypassKey", dbBoolean, False)
currentdb.Properties.Append prop
SetProperty:
If MsgBox("***ENABLE SECURITY BYPASS OPTION ?***", vbYesNo, "Allow Bypass?") = vbYes Then
currentdb.Properties("AllowBypassKey") = True
Else
currentdb.Properties("AllowBypassKey") = False
End If
'****RUN THIS IF THE PROFILE IS NOT ADMIN*****
Else
If UserLevel = "User" Then
DoCmd.OpenForm "Splash_User"
DoCmd.ShowToolbar "Ribbon", acToolbarNo
If Me.PWRESET = True Then
DoCmd.OpenForm "PasswordResetForm"
End If
Else
If UserLevel = "Reporting" Then
DoCmd.OpenForm "Splash_Reporting"
DoCmd.ShowToolbar "Ribbon", acToolbarNo
If Me.PWRESET = True Then
DoCmd.OpenForm "PasswordResetForm"
End If
End If
End If
End If
End If
End If
End Sub
Private Sub Form_Load()
Me.txtloginid.SetFocus
'DoCmd.ShowToolbar "Ribbon", acToolbarNo
Dim myQry As String
Dim sUserName As String
Dim sUserPC As String
' Get Current User Name
sUserName = Environ$("computername")
sUserPC = Environ$("username")
' If you want Computer Name use Environ$("computername") OR ("Username")
'myQry = "INSERT INTO tblLogUserAccess (logUser, logDate) VALUES ('" & sUserName & "',#" & Now() & "#)"
Me.CompUser = sUserName
Me.compname = sUserPC
'currentdb.Execute myQry
End Sub
Private Sub Form_Open(Cancel As Integer)
Database is restricted <--- "
'message = " Welcome To Test "
End Sub
Private Sub Form_Timer()
ownerinfo = message1
'Get first character
Dim FChar As String
FChar = Left(message1, 1)
'Remove first character
message1 = Mid$(message1, 2, Len(message1) - 1)
'Put 1st character at the end of the message.
message1 = message1 + FChar
Me.Auto_Time = Format(Time, "HH:MM:SS AM/PM")
End Sub
Private Sub txtloginid_AfterUpdate()
'GROUP = DLookup("group", "[tbluser]", "[TECH NAME]= '" & [txtloginid] & "'")
Me.txtPassword.SetFocus
End Sub
Private Sub txtloginid_Change()
Me.txtPassword = ""
End Sub
Private Sub txtPassword_AfterUpdate()
'Me.Command1.SetFocus
End Sub
Private Sub txtPassword_Exit(Cancel As Integer)
Me.Command1.SetFocus
End Sub
Last edited: