Hallo Tom,
leg die ein eigenes Modul für das Errorhandling an und gib ihm einen entsprechenden Namen (z.B. basErrorhandler) . Da kommt folgender Code rein:
' **********************************************************************
' Modul: basErrorHandler Typ: Allgemeines Modul
' **********************************************************************
Option Explicit
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" ( _
ByVal hwnd As Long, _
ByVal lpOperation As String, _
ByVal lpFile As String, _
ByVal lpParameters As String, _
ByVal lpDirectory As String, _
ByVal nShowCmd As Long) As Long
Private Declare Function GetActiveWindow Lib "user32.dll" () As Long
Private Const SW_SHOWMAXIMIZED = 3&
Public Sub Error_Handler(lngNumber As Long, strDescription As String, strProcedurname As String)
Dim strErrorText As String
strErrorText = "Fehler: " & CStr(lngNumber) & " - " & strDescription & _
vbLf & vbLf & " Prozedur: " & strProcedurname
MsgBox strErrorText, vbCritical, "Fehler"
Call Send_Error_Mail(strErrorText)
End Sub
Private Sub Send_Error_Mail(strErrorText As String)
Dim lngResult As Long
Dim strBuffer As String
strBuffer = "mailto:Absender@web.de?subject=Fehlermedung!&Body=" & Correct_Syntax(strErrorText)
lngResult = ShellExecute(GetActiveWindow, vbNullString, _
strBuffer, vbNullString, vbNullString, SW_SHOWMAXIMIZED)
If lngResult <= 32 Then MsgBox ShellExecuteErrMessage(lngResult), _
vbCritical, "Fehler beim Mailversand"
End Sub
Private Function Correct_Syntax(strText As String) As String
strText = Replace(strText, "%", "%25")
strText = Replace(strText, vbCr, "%0A")
strText = Replace(strText, vbCrLf, "%0A")
strText = Replace(strText, " ", "%20")
strText = Replace(strText, "!", "%21")
strText = Replace(strText, "#", "%23")
strText = Replace(strText, "*", "%2A")
strText = Replace(strText, "/", "%2F")
strText = Replace(strText, "?", "%3F")
strText = Replace(strText, "Ä", "%C4")
strText = Replace(strText, "Ö", "%D6")
strText = Replace(strText, "Ü", "%DC")
strText = Replace(strText, "ß", "%DF")
strText = Replace(strText, "ä", "%E4")
strText = Replace(strText, "ö", "%F6")
strText = Replace(strText, "ü", "%FC")
Correct_Syntax = strText
End Function
Private Function ShellExecuteErrMessage(lngReturn As Long) As String
Select Case lngReturn
Case 0: ShellExecuteErrMessage = _
"Zuwenig Speicher, ausführbare Datei war zerstört, " & _
"Relokationswerte waren ungültig"
Case 2: ShellExecuteErrMessage = _
"Datei wurde nicht gefunden."
Case 3: ShellExecuteErrMessage = _
"Verzeichnis wurde nicht gefunden."
Case 5: ShellExecuteErrMessage = _
"Fehler beim gemeinsamen Zugriff auf eine Datei im Netz " & _
"oder Fehler beim Zugriff auf eine gesperrte Datei im Netz."
Case 6: ShellExecuteErrMessage = _
"Bibliothek forderte separate Datensegmente für jede Task an."
Case 8: ShellExecuteErrMessage = _
"Zuwenig Speicher, um die Anwendung zu starten."
Case 10: ShellExecuteErrMessage = _
"Falsche Windows-Version."
Case 11: ShellExecuteErrMessage = _
"Ungültige ausführbare Datei. Entweder keine Windows-Anwendung " & _
"oder Fehler in der EXE-Datei."
Case 12: ShellExecuteErrMessage = _
"Anwendung für ein anderes Betriebssystem."
Case 13: ShellExecuteErrMessage = _
"Anwendung für MS-DOS 4.0."
Case 14: ShellExecuteErrMessage = _
"Typ der ausführbaren Datei unbekannt."
Case 15: ShellExecuteErrMessage = _
"Versuch, eine Real-Mode-Anwendung (für eine frühere Windows-Version) zu laden."
Case 16: ShellExecuteErrMessage = _
"Versuch, eine zweite Instanz einer ausführbaren Datei mit mehreren " & _
"Datensegmenten die nicht als nur lesbar gekennzeichnet waren, zu laden."
Case 19: ShellExecuteErrMessage = _
"Versuch, eine komprimierte ausführbare Datei zu laden." & _
"Die Datei muß dekomprimiert werden, bevor sie geladen werden kann."
Case 20: ShellExecuteErrMessage = _
"Ungültige dynamische Linkbibliothek (DLL). Eine der DLLs, die " & _
"benötigt wurde, um die Anwendung auszuführen, war beschädigt."
Case Else: ShellExecuteErrMessage = _
"Ein Unbekannter Fehler ist aufgetreten. (" & CStr(lngReturn) & ")"
End Select
End Function
In einem anderen Modul testen wir nun dieen Errorhandler, indem wir absichtlich einen Fehler erzeugen:
' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************
Option Explicit
Public Sub Beispiel()
Const PROCEDURNAME = "Beispiel"
Dim intIndex As Integer
On Error GoTo err_exit
intIndex = "ABC"
Exit Sub
err_exit:
Call Error_Handler(Err.Number, Err.Description, PROCEDURNAME)
End Sub
Wie du siehst, benötigst du in jeder Prozedur die Konstante "PROCEDURNAME" welche den Namen der Prozedur enthält. Anders kommst du an diesen nicht heran.
Achja, den Empfänger der Mail musst du natürlich korrigieren!!!
Gruß
Nepumuk