[VBA]ログを出力するクラスモジュール

[はじめに]
・最近、Excelマクロを使う機会が増えたので、
　備忘録としてサンプルを掲載します。
　クラスモジュールで定義することを前提としています。

[ソース]

コードのコピー

''' <summary> ''' クラスモジュール名：LogForExcel ''' ログ出力を制御するクラス ''' </summary> ''' <remarks></remarks> Option Explicit 'ログファイルのプレフィックス Private Const LOG_FILE_PREFIX As String = "LOG_" 'ログファイルの拡張子 Private Const LOG_FILE_EXTENSION As String = ".log" 'ログファイルのバッファサイズ Private Const LOG_BUF_SIZE As Integer = 1024 'ログ出力ディレクトリ Public LogDirectory As String 'FileSystemObject Private objFs As Object 'TextStreamObjectのIOモード Private Enum IOMode     ForReading = 0  '読み取り専用モード（既定値）     ForWriting = 1  '上書きモード     ForAppending = 8    '追記モード End Enum 'ログ出力対象 Private colTraget As New Collection ''' <summary> ''' Initializeイベント（コンストラクタ） ''' </summary> ''' <remarks></remarks> Private Sub Class_Initialize()     Set objFs = CreateObject("Scripting.FileSystemObject")          Call ClearLog End Sub ''' <summary> ''' Terminateイベント（デストラクタ） ''' </summary> ''' <remarks></remarks> Private Sub Class_Terminate()          Call Flush          Set objFs = Nothing End Sub ''' <summary> ''' ログを出力する。[Information] ''' </summary> ''' <param name="msg">出力メッセージ</param> ''' <param name="useBuffer">バッファの利用有無</param> ''' <remarks></remarks> Public Sub OutputInfo( _     ByVal msg As String, _     Optional ByVal useBuffer As Boolean = False)          Call OutputLog("Informaton", msg, useBuffer)      End Sub ''' <summary> ''' ログを出力する。[Warning] ''' </summary> ''' <param name="msg">出力メッセージ</param> ''' <param name="useBuffer">バッファの利用有無</param> ''' <remarks></remarks> Public Sub OutputWarn( _     ByVal msg As String, _     Optional ByVal useBuffer As Boolean = False)          Call OutputLog("Warning", msg, useBuffer)      End Sub ''' <summary> ''' ログを出力する。[Error] ''' </summary> ''' <param name="msg">出力メッセージ</param> ''' <param name="objErr">エラーオブジェクト</param> ''' <param name="useBuffer">バッファの利用有無</param> ''' <remarks></remarks> Public Sub OutputError( _     ByVal msg As String, _     Optional ByVal objErr As ErrObject = Nothing, _     Optional ByVal useBuffer As Boolean = False)          Dim strMsg As String          strMsg = msg          If Not (objErr Is Nothing) Then         strMsg = strMsg & ":" & _             "Err.Number:[" & objErr.Number & "]," & _             "Err.Description:[" & objErr.Description & "]:"     End If          Call OutputLog("Error", strMsg, useBuffer) End Sub ''' <summary> ''' ログを出力する。 ''' </summary> ''' <param name="logType">ログ種別</param> ''' <param name="msg">出力メッセージ</param> ''' <param name="useBuffer">バッファの利用有無</param> ''' <remarks></remarks> Private Sub OutputLog( _     ByVal logType As String, _     ByVal msg As String, _     ByVal useBuffer As Boolean)     colTraget.Add _         Format(Now, "yyyy/mm/dd hh:mm:ss") & ":" & _         logType & ":" & msg     If useBuffer = True Then         If colTraget.Count > LOG_BUF_SIZE Then             'バッファがサイズを超えた場合は、ファイルに出力             Me.Flush         End If     Else         'バッファ無効の場合は、ファイルに出力         Me.Flush     End If End Sub ''' <summary> ''' バッファーのデータをログに出力する。 ''' </summary> ''' <remarks></remarks> Public Sub Flush()          Dim objTs As Object 'TextStreamObject     Dim i As Long          On Error GoTo LBL_ERR:          Set objTs = objFs.OpenTextFile( _         fileName:=objFs.BuildPath( _             GetLogDirectory(), _             LOG_FILE_PREFIX & _             Format(Now, "yyyymmdd") & _             LOG_FILE_EXTENSION), _         IOMode:=IOMode.ForAppending, _         Create:=True)     For i = 1 To colTraget.Count         objTs.WriteLine colTraget(i)     Next          objTs.Close     Set objTs = Nothing     Call ClearLog    Exit Sub LBL_ERR:         If Not (objTs Is Nothing) Then         objTs.Close         Set objTs = Nothing     End If          Call ClearLog          Err.Raise _         Number:=Err.Number, _         Description:="ログの出力に失敗しました。" & _         Err.Description End Sub ''' <summary> ''' ログ出力ディレクトリを取得する。 ''' </summary> ''' <returns>ログ出力ディレクトリ（デフォルト：ThisWorkbook.path）</returns> ''' <remarks></remarks> Private Function GetLogDirectory() As String     If Me.LogDirectory = "" Then         GetLogDirectory = ThisWorkbook.Path         Exit Function     End If          GetLogDirectory = Me.LogDirectory End Function ''' <summary> ''' バッファーをクリアする。 ''' </summary> ''' <remarks></remarks> Public Sub ClearLog()     Dim i As Long          For i = colTraget.Count To 1 Step -1         colTraget.Remove i     Next End Sub

[VBA]ログを出力するクラスモジュール

[ソース]

コードのコピー

Private Sub CommandButton1_Click()     Dim logger As New LogForExcel          On Error GoTo LBL_ERR          'ログ出力[Info]     Call logger.OutputInfo("出力テスト（Info）", True)     'ログ出力[Warn]     Call logger.OutputWarn("出力テスト（Warn）", True)          'ゼロ除算で意図的に例外を発生させる。     Debug.Print 1 / 0          Set logger = Nothing          Exit Sub LBL_ERR:          'ログ出力[Error]     Call logger.OutputError("出力テスト（Error）", Err, True)          Set logger = Nothing End Sub

[VBA]使用例

タグ：ログ VBA ログ出力