niedziela, 15 marca 2009

Klasa Logująca w VBA

Dziś w zasadzie przypadkiem poprawiłem kawałek kodu, można powiedzieć klasę do logowania czegokolwiek w plikach tekstowych. W zasadzie całość prosta jak drut :) a co najważniejsze działa.

Jedyną kwestią techniczną na jaką trzeba zwrócić uwagę to nazwa klasy w projekcie ja dałem: cLog
'*************** class cLog start *************************
Option Explicit

Dim sFileName As String
Dim sFile As String
Dim sPath As String
Dim sISAMTable As String
Dim sDelimiter As String

Public Event Error(oErr As ErrObject)

Public Property Let Delimiter(sTmp As String)
    If Len(sTmp) > 1 Then
        Err.Raise vbObjectError + 501, "cLog.Delimiter", "Delimiter o niepoprawnej długości"
        Exit Property
    End If
    sDelimiter = sTmp
End Property

Public Property Get Delimiter() As String
    Delimiter = sDelimiter
End Property

Public Property Let File(sTmp As String)
    If Len(sTmp) < 3 And InStr(sTmp, ".") = 0 Then
        Err.Raise vbObjectError + 502, "cLog.File", "Niepoprawna nazwa pliku"
        Exit Property
    End If
    sFileName = sTmp
End Property

Public Property Get File() As String
    File = sFileName
End Property

Private Sub Class_Initialize()

    sPath = CurrentProject.Path
    sFile = "log" & Format(Now, "yyyymmdd") & ".txt"
    sFileName = Join(Array(sPath, sFile), "\")

    sDelimiter = ";"

End Sub

Public Sub Log(procedura As String, akcja As String, inne As String)

    On Error GoTo ERR_Handler:

    Dim File As Long

    File = FreeFile()

    If Dir(sFileName) = "" Then
        Open sFileName For Output As #File
        Print #File, "godzina" & sDelimiter & "procedura" & sDelimiter & "akcja" & sDelimiter & "inne"
    Else
        Open sFileName For Append As #File
    End If
    Print #File, Format(Now(), "yyyy-mm-dd hh:Nn:ss") & sDelimiter & procedura & sDelimiter & akcja & sDelimiter & inne
    
END_Handler:
    
    Close #1    ' Close file.
    Exit Sub

ERR_Handler:

    RaiseEvent Error(Err)
    Resume END_Handler:

End Sub

Public Sub Kill(Optional sFile)

    On Error GoTo ERR_Handler:

    If IsMissing(sFile) Then
        sFile = sFileName
    End If

    Kill (sFileName)
    Exit Sub

ERR_Handler:

    RaiseEvent Error(Err)

End Sub

'****************** class cLog end *****************
Przykładowy kod wykorzystania poniżej:
Sub Logowanie()
    Dim l As New cLog    ' tworzymy obiekt
    l.Delimiter = ","
    l.File = "raport.log"
    l.Log "t", "e", "ee"    ' dodajemy wpis
'    l.KillLog 'w razie czego można skasować
End Sub
ps. Żeby być sprawiedliwym pomysł i pierwowzór zaczerpnąłem z postu Krzysztofa Naworyty z grupy pl.comp.bazy-danych.msaccess. Po chwili zastanowienia przepisałem ją jednak na nowo praktycznie od zera.

1 komentarz:

  1. fajne, tylko ta wtyczka do kolorowania kodu powoduje złe kopiowanie

    OdpowiedzUsuń