Como puedo atrapar errores en VB y que me notifique via e-mail
Como puedo atrapar errores en VB y que me notifique via e-mail
habra un programa como el que necesito???
gracias
habra un programa como el que necesito???
gracias
El error lo capturas con ON ERROR, y para mandar el correo puedes hacerlo con CDonts o MAPI.
Public Sub ErrorNotify(err As ErrObject, Optional ProcedureName As String, Optional nombre As String)
Dim sSubject As String
Dim sMsg As String
Dim sErrMsg As String
Dim Recipient As String
Recipient = "[email protected]"
sSubject = App.Title & " Mensaje de error de la intranet"
sErrMsg = "Error ocurrido en la forma (" & nombre & ") de la aplicación " & UCase(App.Title) & vbCrLf
If ProcedureName <> "" Then sErrMsg _
= sErrMsg & "Rutina: " & ProcedureName & vbCrLf
sErrMsg = sErrMsg & "Número de error " & CStr(err.Number) _
& " Fue generado por " & err.Source & vbCrLf & _
err.Description
SendOutlookMail sSubject, Recipient, sErrMsg
bitacoraerrorintranet intsistema, GetCurrentUserName, LCase(ComputerName), intemp, nombre, ProcedureName, err.Number, sErrMsg
mensajeerrorintranet err.Number, sErrMsg, ProcedureName, nombre, intsistema
End Sub
Public Sub SendOutlookMail(Subject As String, Recipient As _
String, message As String)
On Error GoTo errorHandler
Dim oLapp As Object
Dim oItem As Object
Set oLapp = CreateObject("Outlook.application")
Set oItem = oLapp.CreateItem(0)
'
With oItem
.Subject = Subject
.To = Recipient
.Body = message
.Send
End With
'
Set oLapp = Nothing
Set oItem = Nothing
'
Exit Sub
errorHandler:
Set oLapp = Nothing
Set oItem = Nothing
Exit Sub
End Sub
Dim sSubject As String
Dim sMsg As String
Dim sErrMsg As String
Dim Recipient As String
Recipient = "[email protected]"
sSubject = App.Title & " Mensaje de error de la intranet"
sErrMsg = "Error ocurrido en la forma (" & nombre & ") de la aplicación " & UCase(App.Title) & vbCrLf
If ProcedureName <> "" Then sErrMsg _
= sErrMsg & "Rutina: " & ProcedureName & vbCrLf
sErrMsg = sErrMsg & "Número de error " & CStr(err.Number) _
& " Fue generado por " & err.Source & vbCrLf & _
err.Description
SendOutlookMail sSubject, Recipient, sErrMsg
bitacoraerrorintranet intsistema, GetCurrentUserName, LCase(ComputerName), intemp, nombre, ProcedureName, err.Number, sErrMsg
mensajeerrorintranet err.Number, sErrMsg, ProcedureName, nombre, intsistema
End Sub
Public Sub SendOutlookMail(Subject As String, Recipient As _
String, message As String)
On Error GoTo errorHandler
Dim oLapp As Object
Dim oItem As Object
Set oLapp = CreateObject("Outlook.application")
Set oItem = oLapp.CreateItem(0)
'
With oItem
.Subject = Subject
.To = Recipient
.Body = message
.Send
End With
'
Set oLapp = Nothing
Set oItem = Nothing
'
Exit Sub
errorHandler:
Set oLapp = Nothing
Set oItem = Nothing
Exit Sub
End Sub
