MyRibbonTools S02_LogSample

Option Explicit

' 参照設定：Microsoft Scripting Runtime
'********************************************************************
'      モジュール：ログ管理
'      ・ログシートの初期化、書き込み、外部出力
'      ・エラーログのテキスト追記（FileSystemObject使用）
'********************************************************************
Option Base 0      ' 配列の開始要素数（0ベース）

'--- タイムスタンプ表示形式（和暦ではなく西暦で統一）
Const C_FormatDateTime As String = "yyyy/mm/dd hh:mm:ss"

Private LogRow As Long    ' ログ書き込み行番号（1行目はヘッダー）

'====================================================================
'      ログシートの初期化処理
'      ※ヘッダー行を作成し、既存ログをクリア
'====================================================================
Sub LogInit()
    With ThisWorkbook.Worksheets("ログ")
        .Cells.Clear
        .Columns(1).NumberFormatLocal = C_FormatDateTime
        .Cells(1, 1).Value = "日時"
        .Cells(1, 2).Value = "メッセージ"
        LogRow = 1    ' ヘッダー行の次から開始
    End With
End Sub

'====================================================================
'      ログメッセージをシートに記録
'      引数：MsgStr - 出力するメッセージ文字列
'====================================================================
Sub LogWrite(ByVal MsgStr As String)
    Debug.Print Format(Now, C_FormatDateTime) & " " & MsgStr

    With ThisWorkbook.Worksheets("ログ")
        .Cells(LogRow + 1, 1).Value = Now
        .Cells(LogRow + 1, 2).Value = MsgStr
        LogRow = LogRow + 1
    End With
End Sub

'====================================================================
'      ログシートの内容をCSV形式でファイル出力（先頭5行）
'====================================================================
Sub InputLog()
    Dim i As Long
    Dim strLogPath As String
    Dim FileNumber As Long

    FileNumber = FreeFile
    strLogPath = ThisWorkbook.Path & "\ログ.Log"

    Open strLogPath For Output As #FileNumber
    For i = 1 To 5
        Print #FileNumber, ThisWorkbook.Worksheets("ログ").Cells(i, 2).Value
    Next i
    Close #FileNumber
End Sub

'====================================================================
'      エラーログをテキストファイルに追記（Ver.1）
'      引数：errMsg - エラーメッセージ
'====================================================================
Sub writeLog(errMsg As String)
    Dim objFSO As Object
    Dim logPath As String

    Set objFSO = CreateObject("Scripting.FileSystemObject")
    logPath = ThisWorkbook.Path & "\error.log"

    ' ファイルが存在しない場合は新規作成
    If objFSO.FileExists(logPath) = False Then
        objFSO.CreateTextFile logPath
    End If

    ' 追記モードで開いてログを書き込む
    With objFSO.OpenTextFile(logPath, 8) ' 8 = ForAppending
        .WriteLine Format(Now, C_FormatDateTime) & vbTab & errMsg
        .Close
    End With

    Set objFSO = Nothing
End Sub
'====================================================================
'      エラーログ書き込みテスト
'====================================================================
Sub TestLog()
    Dim errMsg As String
    errMsg = "きゃはっ（テストエラー）"
    Call writeLog(errMsg)
End Sub

'====================================================================
'      エラーログをテキストファイルに追記（Ver.2）
'      ※Ver.1とほぼ同じだが、CreateObjectの誤記を修正
'====================================================================
Sub writeLog2(errMsg As String)
    Dim objFSO As Object
    Dim logPath As String

    Set objFSO = CreateObject("Scripting.FileSystemObject")
    logPath = ThisWorkbook.Path & "\error.log"

    ' ファイルが存在しない場合は新規作成
    If objFSO.FileExists(logPath) = False Then
        objFSO.CreateTextFile logPath
    End If

    ' 追記モードで開いてログを書き込む
    With objFSO.OpenTextFile(logPath, 8)
        .WriteLine Format(Now, C_FormatDateTime) & vbTab & errMsg
        .Close
    End With

    Set objFSO = Nothing
End Sub