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