So-net無料ブログ作成
検索選択

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

[はじめに]
・最近、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 NothingThen
        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 NothingThen
        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]使用例

メッセージを送る

この広告は前回の更新から一定期間経過したブログに表示されています。更新すると自動で解除されます。