1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91
| Option Compare Database
Option Explicit
Public Enum enmLogType
LogError = 1&
LogWarning = 2&
LogInfo = 4&
End Enum
Public Enum enmErrLevel
lInfo = &H60000000
lWarning = &HA0000000
lError = &HE0000000
End Enum
Public Enum LogEventTypeConstants
vbLogEventTypeError = 1
vbLogEventTypeInformation = 4
vbLogEventTypeWarning = 2
End Enum
Private Declare Function RegisterEventSource Lib "advapi32" Alias "RegisterEventSourceA" (ByVal lpUNCServerName As String, ByVal lpSourceName As String) As Long
Private Declare Function DeregisterEventSource Lib "advapi32" (ByVal hEventLog As Long) As Long
Private Declare Function ReportEvent Lib "advapi32" Alias "ReportEventA" (ByVal hEventLog As Long, ByVal wType As Long, ByVal wCategory As Long, ByVal dwEventID As Long, ByVal lpUserSid As Long, ByVal wNumStrings As Long, ByVal dwDataSize As Long, lpStrings As Any, lpRawData As Any) As Long
Private Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Public Function LogErrorToEventViewer(sErrMsg As String, Optional eEventType As LogEventTypeConstants = vbLogEventTypeError) As Boolean
Dim lEventLogHwnd As Long
Dim LogType As enmLogType
Dim lEventID As Long
Dim lCategory As Long
Dim sServerName As String
Dim lRet As Long
Dim sSourceName As String
LogErrorToEventViewer = True
lCategory = 1
sSourceName = CurrentProject.Name
sServerName = ComputerName()
If eEventType = vbLogEventTypeError Then
LogType = LogError
lEventID = 3& Or enmErrLevel.lError
ElseIf eEventType = vbLogEventTypeInformation Then
LogType = LogInfo
lEventID = 1& Or enmErrLevel.lInfo
ElseIf eEventType = vbLogEventTypeWarning Then
LogType = LogWarning
lEventID = 2& Or enmErrLevel.lWarning
End If
lEventLogHwnd = RegisterEventSource(lpUNCServerName:=sServerName, lpSourceName:=sSourceName)
If lEventLogHwnd = 0 Then
LogErrorToEventViewer = False
Exit Function
End If
lRet = ReportEvent(hEventLog:=lEventLogHwnd, _
wType:=LogType, _
wCategory:=lCategory, _
dwEventID:=lEventID, _
lpUserSid:=0, _
wNumStrings:=1, _
dwDataSize:=0, _
lpStrings:=sErrMsg, _
lpRawData:=0)
If lRet = False Then
LogErrorToEventViewer = False
Else
LogErrorToEventViewer = True
End If
DeregisterEventSource lEventLogHwnd
End Function
Public Function ComputerName() As String
Dim lLong As Long
Dim sTampon As String
Dim iR As Integer
sTampon = Space(255)
lLong = Len(sTampon)
iR = GetComputerName(sTampon, lLong)
ComputerName = Left(sTampon, lLong)
End Function
'Exemple d'utilisation :
Sub test_LogErrorToEventViewer()
LogErrorToEventViewer "Mon message d'erreur"
'Remplace MsgBox "Mon message d'erreur"
'Possibilité de tester si tout c'est bien passé mais en l'occurence, c'est inutile
End Sub |
Partager