ray88’s diary

お仕事で困ったとき用の自分用の覚書

Excel VBA ログ出力部品化(編集中)

'---------------------------------
'引数1:ログ種別(S/N:正常,E:エラー,I:情報)
'引数2:関数名
'引数3:エラーコード(未設定可能)
'引数4:エラーメッセージ(未設定可能)
'引数5:SQL(未設定可能)
'---------------------------------
Public Sub prcOutputLog(ByVal strType As String, ByVal strFuncName As String, _
                        ByVal strErrCode As String, ByVal strErrMsg As String, ByVal strSql As String)
                      
    Dim ts As Object
    Dim fso As Object
    Dim dateNow As Date
    Dim strProjectPath As String
    Dim strLogFolderPath As String
    Dim strLogFilePath As String
    Dim strLogFileName As String
    
'    On Error GoTo ErrTrap
    
    '現在時刻を取得
    dateNow = Now
    
    'ログファイル名
    strLogFileName = "log_" & Format(dateNow, "yyyyMMdd") & ".log"
    
    'プロジェクトパスを取得
    strProjectPath = ThisWorkbook.Path
    'strProjectPath = CurrentProject.Path 'Accessの場合
    
    'ログ格納フォルダ
    strLogFolderPath = strProjectPath & "\Log"
    
    'FileSystemObjectをインスタンス化
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    'ログ格納フォルダの確認(なければ作成)
    If fso.FolderExists(strLogFolderPath) = False Then
        'フォルダを作成する
        fso.CreateFolder (strLogFolderPath)
    End If
    
    'ログファイルのフルパス生成
    strLogFilePath = strLogFolderPath & "\" & strLogFileName
    
    'ファイルオープン(定数「ForAppending」の値は8)
    Set ts = fso.OpenTextFile(strLogFilePath, 8, True)
    
    '書込み
    Select Case strType
        Case "S"
            ts.WriteLine (Format(dateNow, "yyyy/MM/dd HH:nn:ss") & ";" _
            & "Start;" _
            & "Function;" _
            & "処理を開始します")
        Case "N"
            ts.WriteLine (Format(dateNow, "yyyy/MM/dd HH:nn:ss") & ";" _
            & "End;" _
            & "Function;" _
            & "処理を終了します")
        Case "E"
            ts.WriteLine (Format(dateNow, "yyyy/MM/dd HH:nn:ss") & ";" _
            & "Err;" _
            & " " & Format(dateNow, "yyyy/MM/dd HH:nn:ss") & ";" _
            & "エラー発生" _
            & "コード:" & strErrCode & "メッセージ:" & strErrMsg & "SQL:" & strSql)
        Case "I"
            ts.WriteLine (Format(dateNow, "yyyy/MM/dd HH:nn:ss") & ";" _
            & "Infomation;" _
            & " " & Format(dateNow, "yyyy/MM/dd HH:nn:ss") & ";" _
            & "パラメータの文字列をそのまま出力")
    End Select
    
    ts.Close
    Set ts = Nothing
    Set fso = Nothing
    
    Exit Sub
ErrTrap:
                      
End Sub