Error: Registro NO existe, Desea corregir. VBA access
Por un momento creí que ya había solucionado por mi cuenta esta situación. Haber me explico en consultas anteriores me ayudaron con el tratamiento de un error de libro prestado, que por cierto quedó excelente. Bien luego quise, que si el usuario escribe un código de libro que no existe en la base de datos, que se le avise si desea corregir inmediatamente o sale del formulario. Eso lo quise hacer con un tratamiento de error13 dado a que access por default tira ese error cuando se escribe un dato incorrecto. Veo que no me resulta porque ahora que pruebo con un código normal que sí existe me tira el mensaje como que si no existe. Me huele que no estaba allí la solución. Me puede algún experto darme una manito con esto desde ya muchísimas gracias por la ayuda!
Private Sub TexCodLib_AfterUpdate()
Dim DisponL As Boolean
Dim rst As Recordset
Dim Client As String
Dim miSQL As String
On Error GoTo TratarError13
DisponL = Nz(DLookup("Disponible", "02LIBROS", "[CodLib]='" & Me.CodLib & "'"), "")
If DisponL = False Then
miSQL = "SELECT [06CLIENTES].Carnet, [06CLIENTES]![Nombres] & "" "" & [06CLIENTES]![Apellidos] AS CLIENTE FROM (06CLIENTES INNER JOIN (02LIBROS RIGHT JOIN 11VALES_PRÉSTAMO ON [02LIBROS].CodLib = [11VALES_PRÉSTAMO].CodLib) ON [06CLIENTES].Carnet = [11VALES_PRÉSTAMO].Carnet) LEFT JOIN 12DEVOLUCIONES ON [11VALES_PRÉSTAMO].ValeNo = [12DEVOLUCIONES].ValeNo GROUP BY [11VALES_PRÉSTAMO].ValeNo, [11VALES_PRÉSTAMO].CodLib, [02LIBROS].Libro, [06CLIENTES].Carnet, [06CLIENTES]![Nombres] & "" "" & [06CLIENTES]![Apellidos], [12DEVOLUCIONES].DescargoNo HAVING ((([11VALES_PRÉSTAMO].ValeNo)=IIf(IsNull([12DEVOLUCIONES]![DescargoNo]),[11VALES_PRÉSTAMO]![ValeNo],(0))) AND (([11VALES_PRÉSTAMO].CodLib)='" & Me.TexCodLib & "'));"
Set rst = CurrentDb.OpenRecordset(miSQL, dbOpenDynaset)
MsgBox "Los registros muestran que este libro lo tiene prestado: " & vbCrLf & "'" & rst("Cliente") & "'" & vbCrLf & "con Carné No." & rst("Carnet"), vbCritical, "ERROR, LIBRO NO DISPONIBLE"
rst.Close
Set rst = Nothing
Me.Undo
Me.FechaV.SetFocus
Else
TxtCodLib = Nz(DLookup("Libro", "02LIBROS", "[CodLib]='" & Me.CodLib & "'"), "")
TratarError13:
If MsgBox("Por favor rectifique; este Código no existe en los registros." _
& " Quiere salir del formulario para darle Ingreso al Libro, click en SI. " _
& " O click en NO para no salir y corregir en este momento lo que escribió.", vbCritical + vbYesNo, "Código Inexistente") = vbNo Then
Cancel = True
Me.Undo
Me.FechaV.SetFocus
Me.TxtLibro = TxtCodLib
TexCodEq.Enabled = False
TxtEquipo.Enabled = False
Else
DoCmd.Close acForm, "EJECUTAR PRÉSTAMO"
End If
End If
End Sub
1 respuesta
Estás usando mal el control de errores. Los controles de errores se suelen poner al final del código, pero antes del control, se debe poner una instrucción de salida de la función o procedimiento, pues si no se pone, el control de errores se ejecutará siempre (como es tu caso). Mírate el capitulo 13 del curso VBA de la web de neckkito, para aprender a usarlos.
Private Sub TexCodLib_AfterUpdate()
Dim DisponL As Boolean
Dim rst As Recordset
Dim Client As String
Dim miSQL As String
On Error GoTo TratarError13
DisponL = Nz(DLookup("Disponible", "02LIBROS", "[CodLib]='" & Me.CodLib & "'"), "")
If DisponL = False Then
miSQL = "SELECT [06CLIENTES].Carnet, [06CLIENTES]![Nombres] & "" "" & [06CLIENTES]![Apellidos] AS CLIENTE FROM (06CLIENTES INNER JOIN (02LIBROS RIGHT JOIN 11VALES_PRÉSTAMO ON [02LIBROS].CodLib = [11VALES_PRÉSTAMO].CodLib) ON [06CLIENTES].Carnet = [11VALES_PRÉSTAMO].Carnet) LEFT JOIN 12DEVOLUCIONES ON [11VALES_PRÉSTAMO].ValeNo = [12DEVOLUCIONES].ValeNo GROUP BY [11VALES_PRÉSTAMO].ValeNo, [11VALES_PRÉSTAMO].CodLib, [02LIBROS].Libro, [06CLIENTES].Carnet, [06CLIENTES]![Nombres] & "" "" & [06CLIENTES]![Apellidos], [12DEVOLUCIONES].DescargoNo HAVING ((([11VALES_PRÉSTAMO].ValeNo)=IIf(IsNull([12DEVOLUCIONES]![DescargoNo]),[11VALES_PRÉSTAMO]![ValeNo],(0))) AND (([11VALES_PRÉSTAMO].CodLib)='" & Me.TexCodLib & "'));"
Set rst = CurrentDb.OpenRecordset(miSQL, dbOpenDynaset)
MsgBox "Los registros muestran que este libro lo tiene prestado: " & vbCrLf & "'" & rst("Cliente") & "'" & vbCrLf & "con Carné No." & rst("Carnet"), vbCritical, "ERROR, LIBRO NO DISPONIBLE"
rst.Close
Set rst = Nothing
Me.Undo
Me.FechaV.SetFocus
Else
TxtCodLib = Nz(DLookup("Libro", "02LIBROS", "[CodLib]='" & Me.CodLib & "'"), "")
End If
Salida:
Exit Sub
TratarError13:
If MsgBox("Por favor rectifique; este Código no existe en los registros." _
& " Quiere salir del formulario para darle Ingreso al Libro, click en SI. " _
& " O click en NO para no salir y corregir en este momento lo que escribió.", vbCritical + vbYesNo, "Código Inexistente") = vbNo Then
Cancel = True
Me.Undo
Me.FechaV.SetFocus
Me.TxtLibro = TxtCodLib
TexCodEq.Enabled = False
TxtEquipo.Enabled = False
Else
DoCmd.Close acForm, "EJECUTAR PRÉSTAMO"
End If
End SubTen en cuenta que tal como tienes programado el control de errores, cualquiera que sea el error que se produzca (error 13 u otro), te va a dar siempre el mismo mensaje.
