Código Vb de contraseña con 3 intentos

¿Alguien puede indicarme lo que hago mal en el código? No me indica que la contraseña es incorrecta ni las veces que me quedan restan y a la primera me saca del programa. Helppppp

Private Sub CmdEntrar_Click()
     Dim auxContraseña As String
    'Comprobamos que hay datos en las cajas de texto
    If Nz(Me.Txtlogin.Value, "") = "" Then
        MsgBox "Seleccione un nombre de usuario de la lista para acceder", vbInformation, "ATENCION"
        Me.Txtlogin.SetFocus
    ElseIf Nz(Me.TxtPassword.Value, "") = "" Then
            MsgBox "Introduzca la contraseña del usuario seleccionado", vbInformation, "ATENCION"
            Me.TxtPassword.SetFocus
        Else
            If Nz(DLookup("Password", "Usuarios", "Id_usuario=" & Me![Txtlogin]), "") <> "" Then
                auxContraseña = DLookup("Password", "Usuarios", "Id_usuario=" & Me![Txtlogin])
            End If
            If auxContraseña <> Me.TxtPassword.Value Then
                If NumIntentos > 3 Then
                    NumIntentos = NumIntentos + 1
                    MsgBox "La contraseña introducida es incorrecta" & vbCrLf & _
                        "Le quedan " & NumIntentos & " intentos" & vbCrLf & vbCrLf & _
                        "Por favor, introduzca otra", vbExclamation, "INTRODUCCIÓN INCORRECTA"
                        Me.TxtPassword.Value = ""
                        Me.TxtPassword.SetFocus
                Else
                    MsgBox "Ha superado el numero de intentos", vbCritical, "ADIOS..."
                   Application.Quit  'y cerramos el de acceso
                End If
            Else
                If DLookup("Id_acceso", "Usuarios", "Id_usuario=" & Me![Txtlogin]) = 1 Then
                        MsgBox "Contraseña correcta", vbInformation, "BIENVENIDO ADMINISTRADOR"
                        Call Admin
                Else
                        MsgBox "Contraseña correcta", vbInformation, "BIENVENIDO USUARIO"
                        Call Usuar
                End If
                        'DoCmd.OpenForm stDocName, , , stLinkCriteria 'Abrimos el formulario correspondiente
                        DoCmd.Close acForm, Me.NAME 'y cerramos el de acceso
            End If
    End If
End Sub
1

1 Respuesta

62.745 pts. ' Si se puede imaginar se puede programar

Ordena tu codigo no se donde cierran tus if.

Otra observacion

 If DLookup("Id_acceso", "Usuarios", "Id_usuario=" & Me![Txtlogin]) = 1 Then

Esa linea no tiene seguridad pon lo siguiente  'or'1'='1  y entrara si ningún problema 

La verdad es que no tengo ni idea, estaba intentando adaptar el código y funciona correctamente menos lo de los intentos. Quiero que puedas equivocarte hasta tres veces; te lo vaya indicando y sino que te saque del programa. Saludos

¿Es muy necesario para ti que se cierre si pasa los 3 intentos'?

La verdad es que no. Lo único que le da es más vistosidad a la base de datos y que por un error en la contraseña te saque de ella es un pequeño engorro. Gracias

Al final conseguí que me lo pida dos veces, aunque no me dice que es el último intento podría valerme. Muchas gracias por la información. Saludos

Option Compare Database
Option Explicit
Dim NumIntentos As Integer
Private Sub CmdEntrar_Click()
Dim AuxContraseña  As String
'comprobamos que hay datos en las cajas de texto
If Nz(TxtLogin.Value, "") = "" Then
MsgBox "Seleccione un nombre de la lista para poder acceder", vbInformation, "ATENCION"
Me.TxtLogin.SetFocus
ElseIf Nz(Me.TxtPassword.Value, "") = "" Then
        MsgBox "Introduzca la contraseña del usuario seleccionado", vbInformation, "ATENCION"
        Me.TxtPassword.SetFocus
    Else
    If Nz(DLookup("Password", "Usuarios", "Id_Usuario=" & Me![TxtLogin]), "") <> "" Then
        AuxContraseña = DLookup("Password", "Usuarios", "Id_Usuario=" & Me![TxtLogin])
    End If
    If AuxContraseña <> Me.TxtPassword.Value Then
        If NumIntentos < 1 Then
        NumIntentos = 1
        MsgBox "La contraseña introducida es incorrecta" & vbCrLf & _
        "Le queda " & NumIntentos & " intento" & vbCrLf & vbCrLf & _
        "Por favor, introduzca otra", vbExclamation, "INTRODUCCION INCORRECTA"
        Me.TxtPassword.Value = ""
        Me.TxtPassword.SetFocus
    Else
    MsgBox "Ha superado el número de intentos", vbCritical, "ADIOS..."
    DoCmd.Close acForm, Me.Name 'y cerramos el acceso
    End If
Else
If DLookup("Id_Acceso", "Usuarios", "Id_Usuario=" & Me![TxtLogin]) = 1 Then
    MsgBox "Ha entrado el administrador, mostramos todas las tablas", vbInformation, "BIENVENIDO ADMINISTRADOR"
    Call Admin
    Else
    MsgBox "Ha entrado un Usuario, ocultamos todas las tablas", vbInformation, "BIENVENIDO USUARIO"
    Call Usuar
    End If
    'DoCmd.OpenForm stDocName, , , stLinkCriteria  'Abrimos el formulario correspondiente
    DoCmd.Close acForm, Me.Name ' y cerramos el de acceso
    End If
End If
End Sub
Function Admin()
On Error GoTo Admin_Err
DoCmd.OpenForm "Admin", acNormal, "", "", , acNormal
Admin_Exit:
    Exit Function
Admin_Err:
    MsgBox Error$
    Resume Admin_Exit
End Function
Function Usuar()
On Error GoTo Usuar_Err
DoCmd.OpenForm "Usuario", acNormal, "", "", , acNormal
Usuar_Exit:
Exit Function
Usuar
_Err:
MsgBox Error$
Resume Usuar_Exit
End Function
Private Sub Comando13_Click()
End sub

OK. Revisa este login tal vez te agrade

https://www.youtube.com/playlist?list=PLsbpurIPHmoLrU1-d5VAtWpiYhM_Ljvx8 

El código esta en la descripción de cada video

Recuerda cuando si usas la función DLookup para verificar usa y contraseña no funciona. Usa el Dcount mejor

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas