なるべく手間なくログを出力するノウハウ

ログの出力はデバッグでは重要ですね。処理時間も重要ですが、あまり手間なくログを出力したいですよね。
これはログ出力のワンライナーです(嘘)

呼び出し方法

以下、基本プロシージャの1行目に追加して、メソッド名(プロシージャ名)を書き換えるという作業になります。(これさえなくなればさらに楽なのだが)
終了寺のログ出力を書く必要がありません。変数PLがスコープ外になった時にPairLoggerのインスタンスが消滅、終了ログが出力されるという寸法です。

クラスモジュールの場合
TypeName(Me)が使えるので標準モジュールよりはちょっと楽?

Option Explicit
Sub Test()
    Dim PL As PairLogger: Set PL = Constructor(New PairLogger, TypeName(Me) & ".Test")
    
    Dim i As Long
    For i = 1 To 10000
        DoEvents
    Next

End Sub

標準モジュールの場合

Option Explicit
Sub Main()

    Dim PL As PairLogger: Set PL = Constructor(New PairLogger, "Module1.Main")

    Dim i As Long
    
    For i = 1 To 10000
        DoEvents
    Next
    
    Dim c As Class1
    
    Set c = New Class1
    
    c.Test

End Sub

ログ出力結果(イミディエイトウィンドウ)

2019-06-01,11:30:00.559,[1]Module1.Main,BEGIN
2019-06-01,11:30:01.156,[2]Class1.Test,BEGIN
2019-06-01,11:30:01.738,[2]Class1.Test,FINISH,[578]ms
2019-06-01,11:30:01.742,[1]Module1.Main,FINISH,[1188]ms

ソース

ログ出力クラスです。簡略化したものです。(イミディエイトウィンドウに表示されます)
Attribute VB_PredeclaredId = True にし、New しなくても実行できるようにします。(エクスポートして、Trueに書き換えてインポートが必要)

' このクラスは Staticクラス(Attribute VB_PredeclaredId = True) です。
Option Explicit

#If Win64 Then
    Private Declare PtrSafe Function GetTickCount Lib "kernel32" Alias "GetTickCount64" () As LongPtr
#Else
    Private Declare PtrSafe Function GetTickCount Lib "kernel32" () As Long
#End If

'スタック
Private colStack As New Collection
'--------------------------------------------------------------
' 開始ログ
'--------------------------------------------------------------
Public Sub LogBegin(Message As String, ParamArray p())
    
    If colStack Is Nothing Then
        Set colStack = New Collection
    End If
    
    ReportLog "[" & colStack.Count + 1 & "]" & PlaceHolder(Message, p) & ",BEGIN"

    colStack.Add GetTickCount

End Sub
'--------------------------------------------------------------
' 終了ログ
'--------------------------------------------------------------
Public Sub LogFinish(Message As String, ParamArray p())
    
    Dim t As LongPtr

    If colStack Is Nothing Then
        t = 0
    Else
        If colStack.Count = 0 Then
            t = 0
        Else
            t = colStack.Item(colStack.Count)
            colStack.Remove colStack.Count
        End If
    End If
    
    If t = 0 Then
        ReportLog PlaceHolder(Message, p) & ",FINISH,[?]ms"
    Else
        t = GetTickCount - t
        ReportLog "[" & colStack.Count + 1 & "]" & PlaceHolder(Message, p) & ",FINISH,[" & t & "]ms"
    End If
    
End Sub
'ログ出力
Private Sub ReportLog(ByVal strMsg As String)

    Dim strLog As String

    strLog = Format$(Now, "yyyy-mm-dd,hh:nn:ss") & "." & getMSec & "," & strMsg
    Debug.Print strLog

End Sub
'時間の取得(ms)
Private Function getMSec() As String

    Dim dblTimer As Double

    dblTimer = CDbl(Timer)
    getMSec = Format$((dblTimer - Fix(dblTimer)) * 1000, "000")

End Function
'プレースホルダ変換
Private Function PlaceHolder(ByVal strMsg As String, ByVal p As Variant) As String

    If UBound(p) >= 0 Then
        Dim i As Long
        For i = 0 To UBound(p)
            strMsg = Replace(strMsg, "{" & CStr(i) & "}", p(i))
        Next
    End If

    PlaceHolder = strMsg

End Function

最近はやりの(自分の中だけ)コンストラクタ I/F (クラス)

Option Explicit
Public Function Instancing(ByRef Args As Collection) As Object
End Function

コンストラクタ生成ヘルパー(標準モジュール)

'-----------------------------------------------------------------------------------------------------
' コンストラクタ生成
'-----------------------------------------------------------------------------------------------------
Option Explicit

Public Function Constructor(ByRef obj As Object, ParamArray Args() As Variant) As Object

    Dim c As IConstructor
    Dim v As Variant
    
    '引数をCollectionに詰め替える
    Dim col As Collection
    Set col = New Collection
    For Each v In Args
        col.Add v
    Next
    
    'IConstructor Interfaceを呼び出す。
    Set c = obj
    Set Constructor = c.Instancing(col)
    
    'オブジェクトが返却されなかった場合エラー
    If Constructor Is Nothing Then
        Err.Raise vbObjectError + 512 + 1, "Argument Error"
    End If

End Function

ペアロガークラス
今回のキモとなるクラスです。Class_Terminateで終了ログを出力するのがキモになります。

'-----------------------------------------------------------------------------------------------------
' 関数の開始/終了のメッセージを1行で出力するためのクラス
'-----------------------------------------------------------------------------------------------------
' 呼び出し例
'
'クラスの場合
' Dim PL As PairLogger: Set PL = Constructor(New PairLogger, TypeName(Me) & ".FileSearchEx")
'
'標準モジュールの場合
' Dim PL As PairLogger: Set PL = Constructor(New PairLogger, "Module1.FileSearchEx")
'-----------------------------------------------------------------------------------------------------
Option Explicit
Implements IConstructor
Dim m_Msg As String
'----------------------------------------------------
' コンストラクタ
'----------------------------------------------------
Private Function IConstructor_Instancing(ByRef Args As Collection) As Object
    m_Msg = Args(1)
    Logger.LogBegin m_Msg

    Set IConstructor_Instancing = Me

End Function
'----------------------------------------------------
' デストラクタ
'----------------------------------------------------
Private Sub Class_Terminate()
    Logger.LogFinish m_Msg
End Sub

ABOUTこの記事をかいた人

はてなブックマークで驚愕の1600越えを記録した伝説が今明らかに! エクセル方眼紙 四天王の1人(ほぼ最弱)窓の杜大賞2014 大賞受賞! Excelを便利にする250以上の機能を体系化したアドインはこちらです。