ログファイルを出力

VBAでプログラミングをしている際に、ログを残して確認したいことがあります。
ログ出力をクラス化することで、簡単に組み込むことができます。
ログレベルを設定でき、UTF-8で出力します。
ログタイプを設定することで、末尾に追加することもできます。(初期値は上書き)

【サンプルプログラム】

Option Explicit

' ログクラスの定義
Dim log As LogPrint

Sub Sample_LogOutput()
    ' ログクラスの作成
    Set log = New LogPrint

    ' 初期化処理(行わないとログは出力されない)
    log.Initialize "", LOG_LV_INFO  ' ログレベルをINFO以上に設定
    log.LogType = LOG_TP_LASTLINE   ' ファイルの末尾に追加(上書きする場合は、この処理は不要)

    log.Output LOG_LV_DEBUG, "test1"
    log.Output LOG_LV_INFO, "test2"
    log.Output LOG_LV_WARNING, "test3"
    log.Output LOG_LV_ERROR, "test4"
    log.Output LOG_LV_CRITICAL, "test5"

    ' 終了処理
    Set log = Nothing

End Sub

【クラス化】

クラス化では、クラスモジュールを追加します。

クラスが追加されると「Class1」といったクラス名が定義されます。
プロパティで、(オブジェクト名)を 「LogPrint」に変更します。
(別の名前でも大丈夫ですが、クラスを呼び出す際に変更するように注意してください)

以下のコードをクラスモジュールの「LogPrint」のエディタにコピーしてください。

Option Explicit

' ------------------------------------------------------------
' 説明:Log ファイル出力クラス
' ------------------------------------------------------------

' 定義
Public Enum emLogLevel
    LOG_LV_STOP = 0         ' 出力しない
    LOG_LV_DEBUG            ' デバッグ用
    LOG_LV_INFO             ' 情報
    LOG_LV_WARNING          ' 警告
    LOG_LV_ERROR            ' エラー
    LOG_LV_CRITICAL         ' 致命的
End Enum

Public Enum emLogType
    LOG_TP_NEWLONE = 0      ' 新しく追加(前のログは上書きされるため消えます)
    LOG_TP_LASTLINE         ' 最終行に追加
End Enum

' 内部変数
Private OutputLogLevel As emLogLevel
Private OutputLogFilename As String
Private OutputLogType As emLogType
Private ObjFileoutput As Object



' ------------------------------------------------------------
' 説明:出力するログレベルを設定
' 引数:1:設定するログレベル
' ------------------------------------------------------------
Property Let LogLevel(ByVal LogLv As emLogLevel)
    OutputLogLevel = LogLv
End Property


' ------------------------------------------------------------
' 説明:出力するログレベルを取得
' 戻値:設定されているログレベル
' ------------------------------------------------------------
Property Get LogLevel() As emLogLevel
    LogLevel = OutputLogLevel
End Property


' ------------------------------------------------------------
' 説明:出力するログタイプを設定(末尾に追加か、前のログは残さないか)
' 引数:1:設定するログタイプ
' 備考:初回のログを出力する前に設定してください
'       既に同じ名前のファイル名が存在する場合に有効になる設定
' ------------------------------------------------------------
Property Let LogType(ByVal LogTp As emLogType)
    OutputLogType = LogTp
End Property



' ------------------------------------------------------------
' 説明:インスタンス生成時に実行
' 備考:このクラスが生成される際に実行されます(初期化処理)
' ------------------------------------------------------------
Private Sub Class_Initialize()

    LogLevel = LOG_LV_DEBUG
    
End Sub


' ------------------------------------------------------------
' 説明:インスタンス終了時に実行
' 備考:このクラスが終了する際に実行されます(解放時処理)
' ------------------------------------------------------------
Private Sub Class_Terminate()

    If Not ObjFileoutput Is Nothing Then
        ObjFileoutput.Close
    End If

End Sub


' ------------------------------------------------------------
' 説明:ログクラスの初期化
' 引数:1:出力するログファイル名(省略時は備考参考)
' 引数:2:設定するログレベル(省略時はエラーレベル)
' 備考:この関数を呼び出さないとログは出力されません
'       ログファイル名
'       省略時は、Excelファイルの保存先と同じフォルダに同じファイル名(.log)で作成
' ------------------------------------------------------------
Public Sub Initialize(Optional ByVal LogFilename = "", Optional ByVal LogLv = LOG_LV_ERROR)
    OutputLogLevel = LogLv
    
    If LogFilename <> "" Then
        OutputLogFilename = LogFilename
    Else
        ' ログファイル名が空欄の場合
        OutputLogFilename = FilenameNewExtension(ThisWorkbook.FullName, "log")
    End If
    
End Sub


' ------------------------------------------------------------
' 説明:ログの出力
' 引数:1:出力するログファイル名(省略時は備考参考)
' 引数:2:設定するログレベル(省略時はエラーレベル)
' ------------------------------------------------------------
Public Sub Output(ByVal LogLv As emLogLevel, ByVal LogMsg As String)
    Dim tm       As Double   '// Timer値
    Dim Today As Variant
    Dim strLogLv() As Variant
    
    ' ログレベルを配列にセット
    strLogLv = Array("", "DEBUG", "INFO", "WARNING", "ERROR", "CRITICAL")

    If OutputLogLevel <> LOG_LV_STOP Then
    
        If OutputLogLevel <= LogLv Then
        
            Today = Now     ' 日付を取得
            tm = Timer      ' 時間を取得
            
            ' ログに日付を付けて出力
            OutputFile Format(Today, "yyyy/mm/dd hh:mm:ss") & Right(Format(tm, "0.000"), 4) & ", " & strLogLv(LogLv) & ", " & LogMsg
        
        End If
    End If
    
End Sub


' ------------------------------------------------------------
' 説明:ログをファイルに書き込む処理
' 引数:1:書き込む文字列
' ------------------------------------------------------------
Private Sub OutputFile(ByVal LogMsg As String)
    Dim fso As Object

    If ObjFileoutput Is Nothing Then
        Set ObjFileoutput = CreateObject("ADODB.Stream")
        
        With ObjFileoutput
            .Charset = "UTF-8"    ' S-JISの場合、"shift_jis"
            .Open
    
            Set fso = CreateObject("Scripting.FileSystemObject")    ' オブジェクトの作成
            
            If OutputLogType = LOG_TP_LASTLINE Then
                ' 一つのファイルの下に追加していく場合
                If fso.FileExists(OutputLogFilename) Then           ' ファイルの有無を確認
                    ' 書き込まれたファイルの内容を読んでおく
                    .LoadFromFile OutputLogFilename
                End If
            End If
        End With
    End If
        
    With ObjFileoutput
        ' ファイルの最終行に出力
        .Position = ObjFileoutput.Size
        
        ' ファイルへ出力(改行あり)
        .WriteText LogMsg, 1
            
        ' ファイルに書き込む(2:無い場合は作成、有る場合は上書き)
        ' 毎回書き込まないと途中でハングアップした場合に残らない
        .SaveToFile OutputLogFilename, 2
    End With

End Sub


' ------------------------------------------------------------
' 説明:ファイル名から、同じファイル名で拡張子を変更したファイル名を作成
' 引数:1:変換前のファイル名
'       2:変換する拡張子
' 戻値:変換後のファイル名
' ------------------------------------------------------------
Private Function FilenameNewExtension(filename As String, extension As String) As String
    Dim fso As Object
    Dim FolderName As String
    Dim BaseName As String
    
    ' オブジェクトを作成
    Set fso = CreateObject("Scripting.FileSystemObject")    ' オブジェクトの作成
    ' ファイルパスを取得
    FolderName = fso.GetParentFolderName(filename)
    ' 拡張子の無いファイル名を取得
    BaseName = fso.GetBaseName(filename)
    If FolderName <> "" Then
        If extension <> "" Then
            ' ファイルパス+拡張子の無いファイル名 + 新しい拡張子を返す
            FilenameNewExtension = FolderName & "\" & BaseName & "." & extension
        Else
            ' ファイルパス+拡張子の無いファイル名を返す
            FilenameNewExtension = FolderName & "\" & BaseName
        End If
    Else
        If extension <> "" Then
            ' 拡張子の無いファイル名 + 新しい拡張子を返す
            FilenameNewExtension = BaseName & "." & extension
        Else
            ' 拡張子の無いファイル名を返す
            FilenameNewExtension = BaseName
        End If
    End If
End Function

【結果】

コメント