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
【結果】



コメント