【ACCESS/EXCEL/VBA】ログ出力を行うモジュールサンプル

---

ACCESSのみで動作確認をしていますがEXCELでもそのまま使えると思います。
かゆいところに手が届かない部分や雑な箇所があるので、必要に応じてカスタマイズして使用してください。

---

①ファイル出力処理用に
　事前に[ツール]→[参照設定]から[Microsoft Scripting Runtime]を追加する


②以下ログ出力モジュール

Option Compare Database
Option Explicit
 
Private Type systemTime
    Year As Integer
    Month As Integer
    DayOfeek  As Integer
    Day  As Integer
    Hour As Integer
    Minute As Integer
    Second As Integer
    Milliseconds As Integer
End Type
 
Private Declare Sub GetSystemTime Lib "kernel32" (systemTime As systemTime)
Private MeasureStartTime As systemTime
Private MeasureEndTime As systemTime
Private IntermStartTime As systemTime
Private IntermEndTime As systemTime
Private MeasureLog As String
 
Public Sub MeasureStart()
    MeasureStartTime = GetDetailSysTime
    MeasureLog = "計測開始：" & GetFormatSysTime(MeasureStartTime) & vbCrLf
End Sub
 
Public Sub MeasureEnd()
    MeasureEndTime = GetDetailSysTime
    MeasureLog = MeasureLog & _
                 "計測終了：" & GetFormatSysTime(MeasureEndTime) & vbCrLf & _
                 "計測時間：" & GetMeasureTime(IntermStartTime, IntermEndTime) & vbCrLf
                 
    Call OutPutText("Log" & GetUnFormatSysTime(MeasureStartTime), MeasureLog)
End Sub
 
Public Sub IntermStart()
    IntermStartTime = GetDetailSysTime
End Sub
 
Public Sub IntermEnd(ByVal text As String)
    IntermEndTime = GetDetailSysTime
    MeasureLog = MeasureLog & _
                 text & _
                 ":" & _
                 GetFormatSysTime(IntermStartTime) & vbTab & _
                 GetFormatSysTime(IntermEndTime) & vbTab & _
                 GetMeasureTime(IntermStartTime, IntermEndTime) & vbCrLf
End Sub
 
Public Sub AddLog(ByVal text As String)
    MeasureLog = MeasureLog & _
                 text & _
                 ":" & vbTab & _
                 GetFormatSysTime(GetDetailSysTime) & vbCrLf
End Sub
 
Private Function GetDetailSysTime() As systemTime
    Dim sysTime As systemTime
    GetSystemTime sysTime
    GetDetailSysTime = sysTime
End Function
 
Private Sub OutPutText(ByVal fileName As String, ByVal text As String)
    Dim wsh As Object
    Set wsh = CreateObject("WScript.Shell")
    
    Dim fso As FileSystemObject
    Set fso = New FileSystemObject
 
    Dim ts As TextStream
    Set ts = fso.CreateTextFile(wsh.SpecialFolders("Desktop") & "\" & fileName & ".txt", Overwrite:=True, Unicode:=True)
 
    ts.Write (text)
    
    ts.Close
    Set wsh = Nothing
    Set ts = Nothing
    Set fso = Nothing
End Sub
 
Private Function GetFormatSysTime(ByRef sysTime As systemTime) As String
    GetFormatSysTime = CStr(sysTime.Year) & "/" & _
                       Format(sysTime.Month, "00") & "/" & _
                       Format(sysTime.Day, "00") & " " & _
                       Format(sysTime.Hour, "00") & ":" & _
                       Format(sysTime.Minute, "00") & ":" & _
                       Format(sysTime.Second, "00") & "." & _
                       Format(sysTime.Milliseconds, "000")
End Function
 
Private Function GetUnFormatSysTime(ByRef sysTime As systemTime) As String
    GetUnFormatSysTime = CStr(sysTime.Year) & _
                    Format(sysTime.Month, "00") & _
                    Format(sysTime.Day, "00") & _
                    Format(sysTime.Hour, "00") & _
                    Format(sysTime.Minute, "00") & _
                    Format(sysTime.Second, "00") & _
                    Format(sysTime.Milliseconds, "000")
End Function
 
Private Function GetMeasureTime(ByRef sysStartTime As systemTime, _
                                ByRef sysEndTime As systemTime) As String
    Dim startTime As Double
    Dim endTime As Double
    startTime = CDbl(Format(sysStartTime.Hour, "00") & _
                     Format(sysStartTime.Minute, "00") & _
                     Format(sysStartTime.Second, "00") & "." & _
                     Format(sysStartTime.Milliseconds, "000"))
    endTime = CDbl(Format(sysEndTime.Hour, "00") & _
                   Format(sysEndTime.Minute, "00") & _
                   Format(sysEndTime.Second, "00") & "." & _
                   Format(sysEndTime.Milliseconds, "000"))
                                
    GetMeasureTime = Format(CStr(endTime - startTime), "00:00:00.000")
End Function

---

---

③使用例
1.MeasureStartでログを取得開始、
　MeasureEndでログファイルをデスクトップに出力します。
※MeasureStart/MeasureEnd処理は計測時には必須処理となります。
2.MeasureStart～End間の処理で以下の関数を実行すると中間ログの取得が行えます。 　AddLog：引数テキスト、AddLog実行時の時刻をログファイルに出力します。 　IntermStart/IntermEnd：IntermStartで中間ログ計測開始、
　　　　　　　　　　　　 IntermEndで引数テキスト、Start/End時刻、Start～End間の時間をログファイルに出力します。

Private Sub LogSample()
    ' MeasureStart実行でログ計測を開始します
    Call MeasureStart
    
    ' 単純なログを残した場合はAddLogを使用します
    Call AddLog("AddLogサンプル①")
    
    ' 中間の処理時間を図りたい場合はIntermStart-IntermEndを使用します
    ' IntermEndの引数に指定した文言/IntermStartとEnd時刻/IntermEndまでの時間が出力されます。
    Call IntermStart
    ' --ダミー処理---
    Dim i As Long
    Dim str As String
    For i = 0 To 100000
        str = "dammy"
    Next i
    ' --ダミー処理---
    Call IntermEnd("IntermStart/End")
    
    Call AddLog("AddLogサンプル②")
    
    ' MeasureEnd実行でログファイルが出力されます
    Call MeasureEnd
End Sub

④実行結果 　[③使用例]のコードを実行した結果 　以下のファイルがデスクトップに出力される。