ECRIRE DANS LE JOURNAL DES EVENEMENTS EVENTVIEWER

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

19 août 2005 14:26:36 :

ajout de commentaire