【Access】エラーログ処理をクラス化する


以前、エラーログ出力の方法を書きましたが、こういうログ処理というのはクラスにまとめてしまうと使い勝手がよくなります。

LogClass

今回、VBEでクラスモジュールを追加し、名前をLogClassとしました。

プロパティでログファイルの最大サイズやローテーション世代数を設定出来るようにしています。

'定数
Private Const MAX_FILE_SIZE As Long = 4096            'ログファイルサイズ(KB)
Private Const LOG_FILE_NAME As String = "error"       'ログファイル名
Private Const LOG_FILE_EXT As String = "log"          '拡張子名
Private Const LOG_FOLDER As String = "Log"            'フォルダ名
Private Const ROTATE_NUM As Integer = 3               'ログローテーション世代数

'メンバ変数
Private mMaxFileSize As Long                            '最大ログファイルサイズ(KB)
Private mLogFileName As String                          'ログファイル名
Private mLogFileExt  As String                          '拡張子名
Private mLogFolderName As String                        'ログフォルダ名
Private mLogRotateNum As Integer                        'ログローテーション世代数

'Win32API
Private Declare Sub GetLocalTime Lib "kernel32" (lpSystem As SYSTEMTIME)

'構造体
Private Type SYSTEMTIME
    wYear As Integer
    wMonth As Integer
    wDayOfWeek  As Integer
    wDay  As Integer
    wHour As Integer
    wMinute As Integer
    wSecond As Integer
    wMilliseconds As Integer
End Type

'プロパティ
Public Property Let MaxFileSize(ByVal Value As Long)
    mMaxFileSize = Value
End Property

Public Property Let LogFileName(ByVal Value As String)
    mLogFileName = Value
End Property

Public Property Let LogFileExt(ByVal Value As String)
    mLogFileExt = Value
End Property

Public Property Let LogFolderName(ByVal Value As String)
    mLogFolderName = Value
End Property

Public Property Let LogRotateNum(ByVal Value As Integer)
    mLogRotateNum = Value
End Property

'クラス初期化処理
Private Sub Class_Initialize()

    'デフォルト値を設定
    mMaxFileSize = MAX_FILE_SIZE
    mLogFileName = LOG_FILE_NAME
    mLogFileExt = LOG_FILE_EXT
    mLogFolderName = LOG_FOLDER
    mLogRotateNum = ROTATE_NUM

End Sub

'エラーログ作成
Public Sub MakeErrorLog(ByRef errObj As ErrObject, _
                        ByVal procName As String)

    Dim errNumber        As Long
    Dim errDescription   As String
    Dim messageLog       As String
    
    'エラー情報を保管
    errNumber = errObj.Number
    errDescription = errObj.Description
    
    'エラーを消去
    errObj.Clear
    
    messageLog = "【エラー番号】" & errNumber & _
              " 【詳細】" & errDescription & _
              " 【発生場所】" & procName
    
    '書き込み
    Call WriteLog(messageLog)
    
    'メッセージボックス表示
    MsgBox errNumber & Space(2) & errDescription, vbCritical, "エラー"

End Sub

'ログ出力
Private Sub WriteLog(ByVal message As String)
On Error GoTo ErrorTrap

    Dim ts, fso         As FileSystemObject
    Dim projectPath     As String
    Dim logFolder       As String
    Dim logFile         As String
    Dim LogFileName     As String
    Dim sysLocalTime    As SYSTEMTIME
    
    
    '現在時刻を取得
    GetLocalTime sysLocalTime
    
    'ログファイル名
    LogFileName = "error.log"
    
    'プロジェクトパスを取得
    projectPath = CurrentProject.Path
    
    'ログ格納フォルダ
    logFolder = projectPath & "\" & mLogFolderName
    
    'FileSystemObjectオブジェクトを作成する
    Set fso = CreateObject("Scripting.FileSystemObject")
   
    'ログ格納フォルダの確認(なければ作成)
    If fso.FolderExists(logFolder) = False Then
        'フォルダを作成する
        Call fso.CreateFolder(logFolder)
    End If
    
    'ログファイルフルパス名
    logFile = logFolder & "\" & LogFileName
    
    'ログローテート
    Call LogRotate(logFile)
    
    'ファイルオープン
    Set ts = fso.OpenTextFile(logFile, ForAppending, True)

    '書き込み
    Call ts.WriteLine("[" & sysLocalTime.wYear & "/" & _
                        Format(sysLocalTime.wMonth, "00") & "/" & _
                        Format(sysLocalTime.wDay, "00") & " " & _
                        Format(sysLocalTime.wHour, "00") & ":" & _
                        Format(sysLocalTime.wMinute, "00") & ":" & _
                        Format(sysLocalTime.wSecond, "00") & "." & _
                        Format(sysLocalTime.wMilliseconds, "000") & "] " & message)
                      
    'ファイルクローズ
    ts.Close
    
    Set ts = Nothing
    Set fso = Nothing
    
Exit Sub
ErrorTrap:
    MsgBox Err.Number & Space(2) & Err.Description, vbCritical, "エラー"
End Sub

'ログローテート
Private Sub LogRotate(ByVal fileName As String)
On Error GoTo Err_Trap

    Dim fso        As FileSystemObject
    Dim i          As Integer
    Dim r          As Integer
    Dim folderPath As String
    Dim srcFile    As String
    Dim destFile   As String
    Dim oldestFile As String
    Dim checkFile  As String
    Dim fileSize   As Long

    'FileSystemObjectオブジェクトを作成する
    Set fso = CreateObject("Scripting.FileSystemObject")
   
    'ファイルが存在するかチェック
    If fso.FileExists(fileName) = False Then
        Exit Sub
    End If

    'ファイルサイズを取得する
    fileSize = fso.GetFile(fileName).Size

    'ファイルサイズをチェック
    If fileSize < mMaxFileSize * 1024 Then
        '最大サイズを超えてなければ処理を抜ける
        Exit Sub
    End If

    'フォルダパスを取得
    folderPath = fso.GetParentFolderName(fileName)

    '最古ファイルパス
    oldestFile = folderPath & "\" & mLogFileName & mLogRotateNum & "." & mLogFileExt

    '最古ファイルが存在すれば削除
    If fso.FileExists(oldestFile) Then
        Call fso.DeleteFile(oldestFile)
        r = mLogRotateNum - 1
    Else
        'ローテーション世代数を調べる
        For r = (mLogRotateNum - 1) To 0 Step -1
            If r = 0 Then
                checkFile = folderPath & "\" & mLogFileName & "." & mLogFileExt
            Else
                checkFile = folderPath & "\" & mLogFileName & r & "." & mLogFileExt
            End If

            If fso.FileExists(checkFile) Then
                Exit For
            End If
        Next
    End If

    'ファイル名をローテーションする
    For i = r To 0 Step -1
        If i = 0 Then
            srcFile = folderPath & "\" & mLogFileName & "." & mLogFileExt
        Else
            srcFile = folderPath & "\" & mLogFileName & i & "." & mLogFileExt
        End If

        destFile = folderPath & "\" & mLogFileName & i + 1 & "." & mLogFileExt

        If fso.FileExists(srcFile) Then
            'ファイル名変更
            Call fso.MoveFile(srcFile, destFile)
        End If
    Next

Exit_Trap:

    Set fso = Nothing

Exit Sub
Err_Trap:
    MsgBox Err.Number & Space(2) & Err.Description, vbCritical, "エラー"
    Resume Exit_Trap
End Sub

使用例

下記にLogClassの使用例を示します。
まず、LogClassの変数を宣言したあと、SetステートメントのNewキーワードでLogClassオブジェクトのインスタンスを作成します。
インスタンスを作成したら、各プロパティの値を設定しています。このプロパティを設定しなかった場合は、コンストラクタで設定した初期値が使われます。
Public Sub LogClassTest()
On Error GoTo Err_Trap
 
    Dim log As LogClass
    Set log = New LogClass
    
    'ログクラスプロパティ設定
    log.MaxFileSize = 4096
    log.LogFileName = "error"
    log.LogFileExt = "log"
    log.LogFolderName = "Log"
    log.LogRotateNum = 3
    
    Dim a As Long
    
    a = 30 / 0

    MsgBox "a = " & a

Exit Sub
Err_Trap:
    Call log.MakeErrorLog(Err, "LogClassTest")
End Sub








comments powered by Disqus