1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66
|
Private Sub cmdOk_Click()
On Error GoTo Err_cmdOk_Click
Dim db As DAO.Database
Dim rst As DAO.Recordset
Dim rstV As Recordset
Dim rs1 As DAO.Recordset
Dim stDocName As String
Dim stLinkCriteria As String
Set db = CurrentDb()
Set rst = db.OpenRecordset("Security", dbOpenDynaset)
Set rs1 = db.OpenRecordset("compteur", dbOpenDynaset)
If Not IsNull(Me.txtUser) And Not IsNull(Me.txtPassword) Then
rst.FindFirst "Password = '" & Me.txtPassword & "'" & " And UserID = '" & Me.txtUser & "'"
If rst.NoMatch Then
MsgBox "You entered the wrong User Name or Password." & Chr(13) & _
"Please enter the correct User Name and Password or " & Chr(13) & _
"contact the Database Adminstrator for assistance.", vbOKOnly + vbCritical, "Logon Denied"
ElseIf Me.txtPassword = "password" Then
MsgBox "This is the first time using the database or your passowrd has been reset." & Chr(13) & _
"You must change your password before you can enter the database.", _
vbOKOnly + vbExclamation, "Change Password"
stDocName = "SecurityfUserLogonNew"
stLinkCriteria = "[UserID]=" & "'" & Me![txtUser] & "'"
DoCmd.OpenForm stDocName, , , stLinkCriteria
Else
HideForm
stDocName = "Startup"
rs1.MoveFirst
rs1.Edit
rs1!compt = rs1!compt + 1
rs1.Update
DoCmd.OpenForm stDocName, , , stLinkCriteria
End If
Else
MsgBox "You left the User Name and/or Password blank." & Chr(13) & _
"Please enter the correct User Name and Password or " & Chr(13) & _
"contact the Database Adminstrator for assistance.", vbOKOnly + vbCritical, "Logon Denied"
End If
With User
.AccessID = rst.Fields("AccessID")
.ViewID = rst.Fields("ViewID")
.Active = rst.Fields("Active")
.Password = rst.Fields("Password")
.SecurityID = rst.Fields("SecurityID")
.UserID = rst.Fields("UserID")
End With
rst.Close
Exit_cmdOk_Click:
Exit Sub
Err_cmdOk_Click:
MsgBox Err.Description
Resume Exit_cmdOk_Click
End Sub |
Partager