Control de Errores

[javier.mil]

El siguiente "truco" sirve para llevar un control de errores que se producen en tu aplicación
Todos los errores que se generen serán guardados en un fichero plano llamado "Fichero_Errores.txt" y que estará ubicado en la misma ubicación que tu aplicación. Básicamente se guarda la fecha , en nombre del Modulo , el nombre del Ojeto, el nombre del procedimiento , y la linea exacta donde se ha producido el error.

Solo tienes que poner la siguiente instrucción en cada procedimiento

Call funLogErrores(Me.name, "funTest", 9999, Err.number, Err.Description, Erl)



Pon el siguiente código en en Modulo Standard

Código: Seleccionar todo

Option Explicit

Public Function funLogErrores(PonObjeto As String, PonProcedimiento As String, PonErrorPersonal As Long, PonErrorNumber As Long, PonErrorDescripcion As String, Optional PonLinea) As Boolean
On Error GoTo Err_Local

'---------------------------------------------------------------------------------------
' Modulo : modControlErrores
' Procedimiento : Database8
' Tipo Modulo : Módulo
' Fecha : 17/03/2017
' Autor : Javier Gomez ("Javier.Mil")
' Email : accessdemo@hotmail.com
' WEB : http://www.accessdemo.info
' Proposito : Crea un Log de todos los errores encontrados o que pasan en tu Base de Datos
' Example : Call funLogErrores("modControlerrores", "funTest", 9999, Err.number, Err.Description, Erl)
' Erl : En el numero de linea del error
' 9999 : El valor 9999 debes cambiarlo en cada procedimineto y deberia ser un valor unico
'-------------------------------------------------------------------------------------

Const cFicheroTXT As String = "Fichero_Errores.txt"
Dim strArchivo As String
Dim strTexto As String
Dim strRuta As String

DoEvents
DoCmd.Hourglass True
strArchivo = FreeFile

Rem Compruebo si existe el directorio en caso contrario Lo creo
strRuta = CurrentProject.Path & "\"
If Len(Dir(strRuta, vbDirectory)) = 0 Then
MkDir strRuta
End If

Rem Compruebo si existe el fichero TXT en caso contrario Lo creo
strRuta = CurrentProject.Path & "\" & "\" & cFicheroTXT
If Len(Dir(strRuta, vbArchive)) = 0 Then
Rem Aqui crea el fichero TXT
Open strRuta For Output As #strArchivo
Close #strArchivo
End If

strTexto = Format(Now, "yyyy/mm/dd hh:mm:ss") & _
" | Objeto= " & PonObjeto & _
" | Procedimiento= " & PonProcedimiento & _
" | ErrorPersonal= " & PonErrorPersonal & _
" | ErrorNumber= " & PonErrorNumber & _
" | ErrorDescripcion= " & PonErrorDescripcion & _
" | Linea= " & PonLinea

Rem escribe al final del fichero
Open strRuta For Append As #strArchivo

Rem escribe sin comillas
Print #strArchivo, strTexto


' MsgBox "Se ha guardado en el fichero " & cFicheroTXT & "el error", vbInformation, "Aviso"

Close_Local:
Rem cierra
Close #strArchivo

Rem Si llegas hasta aqui es que todo ha ido bien
funLogErrores = True

Exit_Local:
DoCmd.Hourglass False
Exit Function

Err_Local:
funLogErrores = False
MsgBox Err.Description, vbCritical, "Error N°: " & Err.Number
Resume Exit_Local

End Function

'Pon el siguiente codigo en en boton de comando de un Formulario
'El siguiente código solo sirve para provocar un error

Código: Seleccionar todo

Private Function funTest()
10 On Error GoTo Err_Local

Dim varPP As Variant


20 Debug.Print 1 / 0


Exit_Local:
30 On Error GoTo 0
40 Exit Function


Err_Local:
50 Call funLogErrores(Me.Name, "funTest", 9999, Err.Number, Err.Description, Erl)

60 MsgBox Err.Description, vbCritical, "Error N°: " & Err.Number
70 Resume Exit_Local

End Function

En supuesto caso de usar este código dentro de un MODULO habría que sustituir la instrucción Me.Name por el nombre del modulo

.