El emplear el objeto App para escribir en el log de eventos de NT tiene dos limitaciones :

1) No puedes usar el código mientras haces debug.
2) El campo origen en el log siempre muestra "VBRuntime".

Empleando el API podemos solucionar estos problemas. Introduce el siguiente código en la sección de Declaraciones de un módulo:

    Declare Function RegisterEventSource Lib "advapi32.dll" Alias _
        "RegisterEventSourceA" (ByVal lpUNCServerName As String, _
        ByVal lpSourceName As String) As Long

    Declare Function DeregisterEventSource Lib "advapi32.dll" ( _
        ByVal hEventLog As Long) As Long

    Declare Function ReportEvent Lib "advapi32.dll" Alias _
      "ReportEventA" (ByVal hEventLog As Long, ByVal wType As Integer, _
        ByVal wCategory As Integer, ByVal dwEventID As Long, _
        ByVal lpUserSid As Any, ByVal wNumStrings As Integer, _
        ByVal dwDataSize As Long, plpStrings As Long, _
        lpRawData As Any) As Boolean

    Declare Function GetLastError Lib "kernel32" () As Long

    Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
        hpvDest As Any, hpvSource As Any, _
        ByVal cbCopy As Long)

    Declare Function GlobalAlloc Lib "kernel32" ( _
         ByVal wFlags As Long, _
         ByVal dwBytes As Long) As Long

    Declare Function GlobalFree Lib "kernel32" ( _
         ByVal hMem As Long) As Long

    '-- Constantes públicas
    Public Const EVENTLOG_SUCCESS = 0
    Public Const EVENTLOG_ERROR_TYPE = 1
    Public Const EVENTLOG_WARNING_TYPE = 2
    Public Const EVENTLOG_INFORMATION_TYPE = 4
    Public Const EVENTLOG_AUDIT_SUCCESS = 8
    Public Const EVENTLOG_AUDIT_FAILURE = 10

Public Function WriteToEventLog(sMessage As String, _
                           sSource As String, _
                           iLogType As Integer, _
                           vEventID As Integer) As Boolean

    Dim bRC As Boolean
    Dim iNumStrings As Integer
    Dim hEventLog As Long
    Dim hMsgs As Long
    Dim cbStringSize As Long
    Dim iEventID As Integer

    hEventLog = RegisterEventSource("", sSource)
    cbStringSize = Len(sMessage) + 1
    hMsgs = GlobalAlloc(&H40, cbStringSize)
    CopyMemory ByVal hMsgs, ByVal sMessage, cbStringSize
    iNumStrings = 1

    '-- ReportEvent devuelve 0 si falló,
    '-- Cualquier otro número indica que fue bien.
    If ReportEvent(hEventLog, _
       iLogType, 0, _
       iEventID, 0&, _
       iNumStrings, cbStringSize, _
       hMsgs, hMsgs) = 0 Then
        '-- Fallo
        WriteToEventLog = False
    Else
        '-- Correcto
        WriteToEventLog = True
    End If

    Call GlobalFree(hMsgs)
    DeregisterEventSource (hEventLog)
End Function

Un ejemplo de cómo escribir en el log de eventos de NT:


Call WriteToEventLog("Aviso, el fichero excede el tamaño recomendado.", _
"Aplicación de prueba", _
EVENTLOG_WARNING_TYPE, 1003)

Scott Lewis [slewis@vbce.com]