Error de Logueo

[pajuma]

Buenas tardes estoy tratando de loguearme desde un formulario frm_login  teniendo una tabla de usuarios en mi base de datos pero me arroja el siguiente error cuando coloco el usuario y la clave de manera correcta:

se ha producido  el error '91' en tiempo de ejecucion:

variable de objeto o bloque with no establecido.

Favor agradezco su apoyo.para resolver el problema

Sub Ingresar()
Set con = New ADODB.Connection
Set rst = New ADODB.Recordset
Dim cmd As New ADODB.Command
Call Conectar_Sql ' parametros de conexion a la base de datos con sql
Dim TxtUser, txtpass As String
TxtUser = UCase(Trim(Frm_Login.Cmbusuarios.Value))
txtpass = Trim(Frm_Login.TxtClave.Value)
rst.ActiveConnection = con
rst.Source = "Select * From dbo.Tbl_Usuarios where Nombres='" & TxtUser & "'  AND  Dni='" & txtpass & "'" & " AND Estado='1'"
rst.Open
 If rst.RecordCount <> 0 Then
 
               Do While Not rst.EOF
                   If Frm_Login.Cmbusuarios.Value = rst!Nombres And Frm_Login.TxtClave.Value = rst!Dni Then
                      Call Acceso
                    Else
                      Frm_Login.TxtClave.Value = ""
                   End If
                 rst.MoveNext
              Loop
    Frm_Login.TxtClave.Value = ""
 End If
rst.Close
Set rst = Nothing
con.Close
'--------------------------------------------------
End Sub

Sub Acceso()
    Unload Frm_Login
    Frm_Contenedor.Show
End Sub

 

[AlexanderS]

Puedes adjuntar un ejemplo?

Salu2

[logroastur]

Buenas @pajuma

 

Utiliza

Sub Ingresar()
    Dim strSQL  As String
    Dim strCnn  As String
    Dim strPath As String
    Dim cnn     As Object
    Dim rs      As Object
    Dim i       As Long
    Dim TxtUser As String
    Dim TxtPass As String
    Dim retorno As String
    Dim lngICON As Integer
    On Error GoTo ConexErrLogin
'COLOCAR EL PAHT COMPLETO DE LA BASE DATOS
'   POR EJEMPLO
'       strPath = "C:\BasesDatos\BaseLogin\Base.mdb"
    strPath = ""
    TxtUser = UCase(Trim(Cmbusuarios.Value))
    TxtPass = Trim(TxtClave.Value)
    strSQL = "Select * From Tbl_Usuarios where (Nombres='" & TxtUser & "') AND (Dni='" & TxtPass & "'" & ") AND (Estado=1)"
    If CLng(Application.Version) < 120 Then
        strCnn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strPath & ";" & "Persist Security Info=False"
    Else
        strCnn = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strPath & ";Persist Security Info=False;"
    End If
    Set cnn = CreateObject("ADODB.Connection")
    cnn.Open strCnn
    Set rs = CreateObject("ADODB.Recordset")
    rs.Open strSQL, cnn, 1, 1
    i = rs.RecordCount
    Select Case i
        Case 0: lngICON = 16: retorno = "Usuario o password erroneo"
        Case 1: lngICON = 64: retorno = "Bienvenido"
        Case Is > 1: lngICON = 48: retorno = "Bienvenido"
        Case Else: lngICON = 16: retorno = "Usuario o password erroneo"
    End Select
    If rs.State <> 0 Then rs.Close
    Set rs = Nothing
    If cnn.State <> 0 Then cnn.Close
    Set cnn = Nothing
    MsgBox retorno, lngICON, "LOGIN"
    If lngICON > 16 Then
        Unload Frm_Login
        Frm_Contenedor.Show
    End If
    Exit Sub
ConexErrLogin:
    MsgBox Err.Description, vbExclamation, "ERROR Nº:" & Err.Number
End Sub

Un saludo

[pajuma]

gracias  logroastur ,riddle me fue de ay

Sub Ingresar()
Set con = New ADODB.Connection
Set rst = New ADODB.Recordset
Dim cmd As New ADODB.Command
Call Conectar_Sql ' parametros de conexion a la base de datos con sql
Dim TxtUser, txtpass As String
TxtUser = UCase(Trim(Frm_Login.Cmbusuarios.Value))
txtpass = Trim(Frm_Login.TxtClave.Value)
rst.ActiveConnection = con
rst.Source = "Select * From dbo.Tbl_Usuarios where Nombres='" & TxtUser & "'  AND  Dni='" & txtpass & "'" & " AND Estado='1'"
rst.Open
 If rst.RecordCount <> 0 Then
 
               Do While Not rst.EOF
                   If Frm_Login.Cmbusuarios.Value = rst!Nombres And Frm_Login.TxtClave.Value = rst!Dni Then
                      Call Acceso
						exit sub '--solo falto esto para que corra.
                    Else
                      Frm_Login.TxtClave.Value = ""
                   End If
                 rst.MoveNext
              Loop
    Frm_Login.TxtClave.Value = ""
 End If
rst.Close
Set rst = Nothing
con.Close
'--------------------------------------------------
End Sub

uda el codigo se soluciono mi problema comparto