Solved: Centralized Log Manager

[ChloeRadshaw]

I ve built up a fairly generic LogManager which I use in my projects -

At the moment it outputs this to the immediate window

I would like to redirect this into a central file - Do I need to go to the trouble of creating a file per launch of the application??? Or can I have a central file that everyone writes too?

[Oorang]

[VBA]Option Explicit

Public Sub Example()
AppendToFile "C:\Test\log.dat", "I am serious data."
'If you just need the lazy persons way, use this reference free one-liner.
'It does the same thing, and the reference counter takes care of closing
'the connection:
AppendToFile2 "C:\Test\log.dat", "I am also serious data."
End Sub

Public Sub AppendToFile(ByVal path As String, ByVal value As String)
'You need to set a reference to Microsoft Scripting Runtime for this to work:
Dim fso As Scripting.FileSystemObject
Dim ts As Scripting.TextStream
Set fso = New Scripting.FileSystemObject
Set ts = fso.OpenTextFile(path, ForAppending, True)
ts.WriteLine value
ts.Close
End Sub

Public Sub AppendToFile2(ByVal path As String, ByVal value As String)
CreateObject("Scripting.FileSystemObject").OpenTextFile(path, 8&, True).WriteLine value
End Sub
[/VBA]

[Bob Phillips]

Why not write to the NT Events log, an already centralised resource?

[Oorang]

That could be a good solution if it's machine specific: http://support.microsoft.com/kb/154576

Personally I usually log everything out to the same location on shared drive so I can I peruse the log when I want and have all the logs pre-aggregated. But if you are deploying in non-corporate environment (say a publicly available add-in etc) then machine logging makes a lot of sense.

[ChloeRadshaw]

That could be a good solution if it's machine specific: http://support.microsoft.com/kb/154576

Personally I usually log everything out to the same location on shared drive so I can I peruse the log when I want and have all the logs pre-aggregated. But if you are deploying in non-corporate environment (say a publicly available add-in etc) then machine logging makes a lot of sense.

Can you post your errorhandler - I could not see how to sepcify one single file for everyone to log too

That would be ideal

[Oorang]

The only thing you really need to do is make sure the log path is on a shared drive. As for the error handler I usually make one Error Handling Module and have all error handlers use it. You can get fancier obviously, but this should be more than enough for most situations.
[vba]Option Explicit

Private Const m_strModuleName_c As String = "Module1"

Public Sub CodeStub()
Const strProcedure_c As String = "CodeStub"
On Error GoTo Err_Hnd
Excel.Application.Cursor = xlWait
9 Debug.Print 1 / 0 '<Cause an error
Exit_Proc:
On Error Resume Next
Excel.Application.Cursor = xlDefault
Exit Sub
Err_Hnd:
'Note:
' - If you are in a class you can just use typename(me) instead of
' m_strModuleName_c.
' - Erl only works if you use line numbers (some people hate them). MZ
' tools has some nice line number managment features.
HandleError m_strModuleName_c, strProcedure_c, Err.Description, Err.Number, _
erl
Resume Exit_Proc
End Sub

Public Sub AppendToFile(ByVal path As String, ByVal value As String)
CreateObject("Scripting.FileSystemObject").OpenTextFile(path, 8&, _
True).WriteLine value
End Sub

Public Sub HandleError(ByVal module As String, ByVal procedure As String, ByVal _
errDescr As String, ByVal errNum As Long, ByVal erl As Long)
'Change this to be a path on a shared drive. Example(s):
' "\\MyServer\Data\Logs\MyAppLog.dat"
' "S:\Data\Logs\MyAppLog.dat"
Const strLogPath_c As String = "C:\Test\log.dat"
Dim strMsg As String
AppendToFile strLogPath_c, Join(Array(Now, Environ$("USERNAME"), _
Environ$("COMPUTERNAME"), module, procedure, errDescr, errNum, erl), vbTab)
strMsg = "Error " & errNum & " in " & module & "." & procedure & " on line " _
& erl & ":" & vbNewLine & Err.Description
MsgBox strMsg, vbCritical + vbApplicationModal + vbMsgBoxSetForeground, _
"Exception"
End Sub[/vba]

[ChloeRadshaw]

The only thing you really need to do is make sure the log path is on a shared drive. As for the error handler I usually make one Error Handling Module and have all error handlers use it. You can get fancier obviously, but this should be more than enough for most situations.
[vba]Option Explicit

Private Const m_strModuleName_c As String = "Module1"

Public Sub CodeStub()
Const strProcedure_c As String = "CodeStub"
On Error GoTo Err_Hnd
Excel.Application.Cursor = xlWait
9 Debug.Print 1 / 0 '<Cause an error
Exit_Proc:
On Error Resume Next
Excel.Application.Cursor = xlDefault
Exit Sub
Err_Hnd:
'Note:
' - If you are in a class you can just use typename(me) instead of
' m_strModuleName_c.
' - Erl only works if you use line numbers (some people hate them). MZ
' tools has some nice line number managment features.
HandleError m_strModuleName_c, strProcedure_c, Err.Description, Err.Number, _
erl
Resume Exit_Proc
End Sub

Public Sub AppendToFile(ByVal path As String, ByVal value As String)
CreateObject("Scripting.FileSystemObject").OpenTextFile(path, 8&, _
True).WriteLine value
End Sub

Public Sub HandleError(ByVal module As String, ByVal procedure As String, ByVal _
errDescr As String, ByVal errNum As Long, ByVal erl As Long)
'Change this to be a path on a shared drive. Example(s):
' "\\MyServer\Data\Logs\MyAppLog.dat"
' "S:\Data\Logs\MyAppLog.dat"
Const strLogPath_c As String = "C:\Test\log.dat"
Dim strMsg As String
AppendToFile strLogPath_c, Join(Array(Now, Environ$("USERNAME"), _
Environ$("COMPUTERNAME"), module, procedure, errDescr, errNum, erl), vbTab)
strMsg = "Error " & errNum & " in " & module & "." & procedure & " on line " _
& erl & ":" & vbNewLine & Err.Description
MsgBox strMsg, vbCritical + vbApplicationModal + vbMsgBoxSetForeground, _
"Exception"
End Sub[/vba]

Beautiful - Thank you.

[Oorang]

Addendum... Ran across this example from Peter Walker while doing something else, I made a few very small changes to it to prevent side scrolling but I have reposted it here mostly unaltered. Original URL

[vba]Option Explicit
'peter walker Feb,21 2001
'To write to the NT Log requires at least 3 api operations.
'RegisterEventSource
'ReportEvent
'DeregisterEventSource
'(but because of the pointers required in the ReportEvent some memory apis are also used)

'The RegisterEventSource function looks for the lpSourceName
'as a key in the registry as shown below. (VBRuntime)
'We are using the VBRuntime key in this sample.

'HKEY_LOCAL_MACHINE
' System
' CurrentControlSet
' Services
' EventLog
' Application
' VBRuntime


'You could still use the vbruntime library to host the message but
'under a different key. This would allow the log to display *your*
'application name in the log. For instance..

'HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Services\EventLog\Application\ PawLogger

'The complete reg entry (file) would be
'REGEDIT4

'[HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Services\EventLog\Application\P awLogger]
'"EventMessageFile"="C:\\WINNT\\System32\\msvbvm50.dll"
'"TypesSupported"=dword:00000007

Private Const GMEM_ZEROINIT = &H40

Private Const EVENTLOG_ERROR_TYPE = 1 'Error icon in log
Private Const EVENTLOG_WARNING_TYPE = 2 'Exclaimation icon in log
Private Const EVENTLOG_INFORMATION_TYPE = 4 'Info icon in log

Declare Function RegisterEventSource Lib "advapi32.dll" Alias _
"RegisterEventSourceA" (ByVal lpUNCServerName As String, ByVal lpSourceName As _
String) 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, lpStrings As Long, lpRawData As Any) As Boolean

Declare Function DeregisterEventSource Lib "advapi32.dll" (ByVal hEventLog As _
Long) 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

Public Function LogEvent(EventSourceName As String, EventType As Integer, _
EventID As Integer, EventCategory As Integer, EventDescription As String) As _
Boolean
Dim hEventSource As Long
Dim hGlobal As Long
Dim UNCServerName As String
LogEvent = False
UNCServerName = "" 'This machine
EventDescription = "..." & vbCrLf & EventDescription

hGlobal = GlobalAlloc(GMEM_ZEROINIT, Len(EventDescription) + 1)
CopyMemory ByVal hGlobal, ByVal EventDescription, Len(EventDescription) + 1

hEventSource = RegisterEventSource(UNCServerName, EventSourceName)
If ReportEvent(hEventSource, EventType, EventCategory, EventID, 0&, 1, 0, _
hGlobal, 0) Then LogEvent = True

GlobalFree (hGlobal)
DeregisterEventSource (hEventSource)
End Function

Sub TEST()
Dim EventType As Integer, EventID As Integer, EventCategory As Integer
Dim Host_Dll As String
EventType = EVENTLOG_ERROR_TYPE
EventID = 1 ' Depends on the dll loaded via RegisterEventSource
EventCategory = 0 'none
Host_Dll = "vbruntime" 'via source key see notes top of module

Debug.Print LogEvent(Host_Dll, EventType, EventID, EventCategory, "Oh noes!")
End Sub
[/vba]