ReportEvent

'Example by Bhavin (sanghvibk@hotmail.com)
'Sample code to write Event Log.

'More information: I've posted this functionality here before,
'but it needed a supporting exe. This way of writing to the Event
'Viewer is done with API calls and no supporting files are needed.
'Just add the code to a module or class module. Call the
'LogErrorToEventViewer method, passing in the message and the
'severity level and it will write to the Event Viewer on the NT
'box that your currently using. With a little modification you can
'add binary data to your posted event, Populate the User field in
'the message and you can write to a different NT machine's Event
'Viewer. Just do some research on the api calls to figure those out.

'I 've written this because VB's LogEvent method is really no good.
'It works only part of the time and under the Source header in the
'Event Viewer it writes VBRuntime. So if you have 5 apps writing to
'the Event Viewer, all 5 have VBRuntime at the source. Not very
'helpful. This way you can easily see what apps have errors.

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 LogErrorToEventViewer(sErrMsg As String, eEventType As LogEventTypeConstants) 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

    LogErrorToEventViewer = True
    Const sSourceName = "UnshippedOrders"
    lCategory = 1
    sServerName = vbNullString

    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
    End If

    DeregisterEventSource lEventLogHwnd
End Function

Close this window