- a mettre dans un module :
-
- Option Explicit
- Public Enum enmLogType
- LogError = 1&
- LogWarning = 2&
- LogInfo = 4&
- End Enum
-
- Public Enum enmErrLevel
- lInfo = &H60000000
- lWarning = &HA0000000
- lError = &HE0000000
- 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
-
-
-
-
- Public Function WriteToEventViewer(sErrMsg As String, eEventType As LogEventTypeConstants, IDEvent As Integer, Optional sSourceName As String) As Boolean
- On Error Resume Next
-
- Dim lEventLogHwnd As Long
- Dim LogType As enmLogType
- Dim lEventID As Long
- Dim lCategory As Long
- Dim sServerName As String
- Dim lRet As Long
-
- WriteToEventViewer = True
- If sSourceName = "" Then sSourceName = App.EXEName
- lCategory = 0
- sServerName = vbNullString
-
- If eEventType = vbLogEventTypeError Then
- LogType = LogError
- lEventID = IDEvent Or enmErrLevel.lError
- ElseIf eEventType = vbLogEventTypeInformation Then
- LogType = LogInfo
- lEventID = IDEvent Or enmErrLevel.lInfo
- ElseIf eEventType = vbLogEventTypeWarning Then
- LogType = LogWarning
- lEventID = IDEvent Or enmErrLevel.lWarning
- End If
-
- lEventLogHwnd = RegisterEventSource(lpUNCServerName:=sServerName, lpSourceName:=sSourceName)
-
- If lEventLogHwnd = 0 Then
- WriteToEventViewer = 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
- WriteToEventViewer = False
- End If
-
- DeregisterEventSource lEventLogHwnd
- End Function
-
-
a mettre dans un module :
Option Explicit
Public Enum enmLogType
LogError = 1&
LogWarning = 2&
LogInfo = 4&
End Enum
Public Enum enmErrLevel
lInfo = &H60000000
lWarning = &HA0000000
lError = &HE0000000
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
Public Function WriteToEventViewer(sErrMsg As String, eEventType As LogEventTypeConstants, IDEvent As Integer, Optional sSourceName As String) As Boolean
On Error Resume Next
Dim lEventLogHwnd As Long
Dim LogType As enmLogType
Dim lEventID As Long
Dim lCategory As Long
Dim sServerName As String
Dim lRet As Long
WriteToEventViewer = True
If sSourceName = "" Then sSourceName = App.EXEName
lCategory = 0
sServerName = vbNullString
If eEventType = vbLogEventTypeError Then
LogType = LogError
lEventID = IDEvent Or enmErrLevel.lError
ElseIf eEventType = vbLogEventTypeInformation Then
LogType = LogInfo
lEventID = IDEvent Or enmErrLevel.lInfo
ElseIf eEventType = vbLogEventTypeWarning Then
LogType = LogWarning
lEventID = IDEvent Or enmErrLevel.lWarning
End If
lEventLogHwnd = RegisterEventSource(lpUNCServerName:=sServerName, lpSourceName:=sSourceName)
If lEventLogHwnd = 0 Then
WriteToEventViewer = 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
WriteToEventViewer = False
End If
DeregisterEventSource lEventLogHwnd
End Function