【Access VBA】クラスモジュールDebugLogOnAccdbでAccess VBAのデバッグログを取りデバッグを劇的に効率化しよう

Public DebugLog As New DebugLogOnAccdb

DebugLog.SaveFormLog "Form_Open"
    :
DebugLog.SaveFormLog "Form_Open", Err.Description

DebugLog.SaveLog "Procedure_Name"
    :
DebugLog.SaveLog "Procedure_Name", Err.Description

2023/09/10 23:51:17 SampleDB.accdb : Sample : 起動されました。
2023/09/10 23:58:57 SampleDB.accdb : frm002 : Form_Open : Something good
2023/09/11 00:06:19 SampleDB.accdb : frm002 : Form_Open : 起動されました。
2023/09/11 00:06:19 SampleDB.accdb : frm002 : Form_Open : Something good
2023/09/11 00:06:22 SampleDB.accdb : frm001 : Form_Open : 起動されました。

Public DebugLog As New DebugLogOnAccdb

Private Sub Form_Open(Cancel As Integer)
    DebugLog.SaveFormLog "Form_Open"
    Call StandardizeTextboxes(Me)
    On Error GoTo Err_Form_Open
' ここに個別処理を記述
Exit_Form_Open:
    Exit Sub
Err_Form_Open:
    DebugLog.SaveFormLog "Form_Open", Err.Description
    Resume Exit_Form_Open
    
End Sub

Sub Sample()
    DebugLog.SaveLog "Sample"    
    On Error GoTo Err_Sample
    ' ここに個別処理を記述
Exit_Sample:
    Exit Sub
Err_Sample:
    DebugLog.SaveLog "Sample", Err.Description
    Resume Exit_Sample
End Sub

DebugLog.Show
2023/09/10 23:51:17 SampleDB.accdb : Sample : 起動されました。
2023/09/10 23:58:57 SampleDB.accdb : frm002 : Form_Open : Something good
2023/09/11 00:06:19 SampleDB.accdb : frm002 : Form_Open : 起動されました。
2023/09/11 00:06:19 SampleDB.accdb : frm002 : Form_Open : Something good
2023/09/11 00:06:22 SampleDB.accdb : frm001 : Form_Open : 起動されました。

? DebugLog.FilePath
C:\Users\devel\Tools_Data_Logs\accdb\Sampledb.log

? DebugLog.IsDebugMode
True

Option Compare Database

' ログファイルのパスを格納する変数
Private logFilePath As String

' ログファイルの最大行数
Private Const MAX_LOG_LINES As Integer = 50

' デバッグモードの有効/無効を切り替えるフラグ
Private Const DEBUG_MODE As Boolean = True

' ログのファイルパスのGetterプロパティ
Property Get FilePath() As String
    FilePath = logFilePath
End Property

' デバッグモードのGetterプロパティ
Property Get IsDebugMode() As Boolean
    IsDebugMode = DEBUG_MODE
End Property

' クラスの初期化
Private Sub Class_Initialize()
    
    ' ファイルシステムオブジェクトの生成
    Dim fsObject As Object
    Set fsObject = CreateObject("Scripting.FileSystemObject")
    
    ' ユーザーのプロファイルディレクトリにログディレクトリを作成
    logFilePath = Environ("UserProfile") & "\Tools_Data_Logs"
    If Not fsObject.FolderExists(logFilePath) Then
        MkDir (logFilePath)
    End If
    
    ' ログディレクトリ内に.accdbディレクトリを作成
    logFilePath = logFilePath & "\accdb"
    If Not fsObject.FolderExists(logFilePath) Then
        MkDir (logFilePath)
    End If
    
    Set fsObject = Nothing
    
    ' ログファイルのパスを設定
    logFilePath = Environ("UserProfile") & "\Tools_Data_Logs\accdb\" & Replace(CurrentProject.Name, ".accdb", ".log")
    
End Sub

' クラスの終了処理
Private Sub Class_Terminate()
    
    ' ファイルシステムオブジェクトの生成
    Dim fsObject As Object
    Set fsObject = CreateObject("Scripting.FileSystemObject")
    
    ' ログファイルが存在する場合、削除
    If fsObject.FileExists(logFilePath) = True Then
        fsObject.DeleteFile filespec:=logFilePath, force:=True
        Debug.Print logFilePath & " が削除されました。"
    End If
    
End Sub

Set DebugLog = Nothing
C:\Users\devel\Tools_Data_Logs\accdb\Access開発_実践ノウハウ.log が削除されました。

' ログファイルの行数を制限するサブルーチン
Private Sub TruncateLog()
    
    ' ログファイルの内容を一時的に保持する配列
    Dim logBuffer() As String
    Dim logLineCounter As Integer
    Dim line As String
    
    ' ファイルシステムオブジェクトの生成
    Dim fsObject As Object
    Set fsObject = CreateObject("Scripting.FileSystemObject")
    
    ' ログファイルが存在する場合
    If fsObject.FileExists(logFilePath) = True Then
        
        Dim fileNo As Integer
        fileNo = FreeFile
    
        ' ログファイルを読み込み、行数を数える
        Open logFilePath For Input As #fileNo
        
        logLineCounter = 0
        Do Until EOF(1)
            Line Input #fileNo, line
            If (Len(line) <> 0) Then
                logLineCounter = logLineCounter + 1
            End If
        Loop
        Close #fileNo
        
        ' ログバッファの初期化
        ReDim logBuffer(logLineCounter)
        
        ' ログファイルを再度読み込み、ログバッファに格納
        Open logFilePath For Input As #fileNo
        
        logLineCounter = 0
        Do Until EOF(1)
            Line Input #fileNo, line
            If Len(line) <> 0 Then
                logBuffer(logLineCounter) = line
                logLineCounter = logLineCounter + 1
            End If
        Loop
        Close #fileNo
                
        ' ログファイルが最大行数を超える場合、古いログを削除して新しいログを保存
        If logLineCounter > MAX_LOG_LINES Then
            fsObject.DeleteFile filespec:=logFilePath, force:=True
            fileNo = FreeFile
            
            ' ログファイルを追記モードで開き、最新のログだけを保存
            Open logFilePath For Append As #fileNo
            
            Dim index As Integer
            For index = logLineCounter - MAX_LOG_LINES To logLineCounter
                Print #fileNo, logBuffer(index)
            Next index
            
            Close #fileNo
            
        End If
        
    End If
    
End Sub

' フォームのログを保存するサブルーチン
Sub SaveFormLog(proc_name As String, Optional error_message As String)
    
    ' エラーメッセージが指定されていない場合、"起動されました。"を使用
    If error_message = "" Then
        error_message = "起動されました。"
    End If
        
    ' デバッグモードが有効な場合のみログを出力
    If debug_mode = True Then
        
        ' デバッグウィンドウにログを出力
        Debug.Print Format(Now(), "yyyy/mm/dd hh:nn:ss") & " " & CurrentProject.Name & " : " & CodeContextObject.Name & " : " & proc_name & " : " & error_message
        
        Dim fileNo As Integer   ' ファイル番号
        fileNo = FreeFile
        
        ' ログファイルを追記モードで開き、ログを保存
        Open logFilePath For Append As #fileNo
        Print #fileNo, Format(Now(), "yyyy/mm/dd hh:nn:ss") & " " & CurrentProject.Name & " : " & CodeContextObject.Name & " : " & proc_name & " : " & error_message
        Close #fileNo
        
        ' ログの行数を制限
        Call TruncateLog
        
    End If
    
End Sub

' プロシージャ・関数のログを保存するサブルーチン
Sub SaveLog(proc_name As String, Optional error_message As String)
    
    ' エラーメッセージが指定されていない場合、"起動されました。"を使用
    If error_message = "" Then
        error_message = "起動されました。"
    End If
        
    ' デバッグモードが有効な場合のみログを出力
    If debug_mode = True Then
        
        ' デバッグウィンドウにログを出力
        Debug.Print Format(Now(), "yyyy/mm/dd hh:nn:ss") & " " & CurrentProject.Name & " : " & proc_name & " : " & error_message
        
        Dim fileNo As Integer   ' ファイル番号
        fileNo = FreeFile
        
        ' ログファイルを追記モードで開き、ログを保存
        Open logFilePath For Append As #fileNo
        Print #fileNo, Format(Now(), "yyyy/mm/dd hh:nn:ss") & " " & CurrentProject.Name & " : " & proc_name & " : " & error_message
        Close #fileNo
        
        ' ログの行数を制限
        Call TruncateLog
        
    End If
    
End Sub

' ログを表示するサブルーチン
Sub ShowLog()
    
    ' ファイルシステムオブジェクトの生成
    Dim fsObject As Object
    Set fsObject = CreateObject("Scripting.FileSystemObject")
    
    Dim logLine As String
    
    ' デバッグモードが有効な場合のみログを表示
    If DEBUG_MODE = True Then
        
        ' ログファイルが存在する場合
        If fsObject.FileExists(logFilePath) = True Then
            
            Dim fileNo As Integer
            fileNo = FreeFile
            
            ' ログファイルを読み込み、内容をデバッグウィンドウに表示
            Open logFilePath For Input As #fileNo
            
            Do Until EOF(1)
                Line Input #fileNo, logLine
                Debug.Print logLine
            Loop
            Close #fileNo
            
        End If
        
    End If
    
End Sub