最近、私の社内でもかなりな人数が常時利用するような業務をExcelで作成し運用する例が多くなりつつあります。当然、ExcelやWindowsのバージョン問題等にも出くわすのですが、エラーでの問い合わせや対処のために、このサンプルのようなログを自動的に採取する方法を採っています。
サンプルには、「わざと」エラーを起こすプロシージャを用意しています。
(この画像をクリックすると、ダウンロードができます。)
実際のところは、エラーが発生したなどと問い合わせを受けても、「どのようなエラー」が「どのような状況で発生した」かなどが正確に伝わらないことが多く、また、環境に依存して開発元では再現しないこともあります。このため、エラー発生時の状況を少しでも詳しく捉えようとして作成したものです。
単なるエラーメッセージだけでなく、以下の内容をログファイルに採取できます。
| [表示エラー] | ※発生プログラム側でセット(エラーコード、エラー名称) |
| [発生日時] | ・エラー処理側で自動セット(システム日時) |
| [ファイル名] | ・エラー処理側で自動セット(アクティブなワークブック名) |
| [バージョン] | ※発生プログラム側でセット(Ver値、Ver更新日付：任意) |
| [機器・環境] | ・エラー処理側で自動セット(コンピュータ名、OSバージョン、Excelバージョン) |
| [ユーザー名] | ・エラー処理側で自動セット(ログインユーザ：発生プログラムで指定することも可) |
| [処理名] | ※発生プログラム側でセット(日本語の処理タイトル、起動したメニュー名等) |
| [実行処理名] | ※発生プログラム側でセット(発生プロシージャ名、プロシージャ内工程名) |
| [変数スナップショット等] | ※発生プログラム側でセット(プロシージャ内の変数名とその変数の値をテキストで編集) |
これなら、「どの処理」の「どの工程」で「何のエラー」が発生し、その時点の変数格納値も判るので、対応方法の判定も迅速に行なえると思います。
組み込みは、「modOutputFatalLog.bas」をインポートして、この内部の「OUTPUT_FATAL_LOG」を呼び出す記述を追加します。
'***************************************************************************************************
' 共通画面制御＋FATALエラーログ出力(サンプル) Module1(Module)
'
' 作成者:井上治 URL:https://www.ne.jp/asahi/excel/inoue/ [Excelでお仕事!]
'***************************************************************************************************
'変更日付 Rev 変更履歴内容------------------------------------------------------------------------>
'03/08/23(1.00)新規作成
'20/01/09(1.20)ソース整理(標準化準拠)
'***************************************************************************************************
Option Explicit
Option Private Module
'===================================================================================================
Private Const g_cnsTITLE As String = "FATALログ出力(サンプル)" ' タイトル
Private Const g_cnsVER As String = "1.2" ' バージョン
Private Const g_cnsVER_DATE As String = "2020/01/09" ' バージョン更新日
Private Const g_cnsLOG_FILE As String = "FATAL_LOG.log" ' LOGファイル名
'***************************************************************************************************
' ■■■ 共通サブ処理 ■■■
'***************************************************************************************************
'* 処理名 ：GP_FATAL_ERROR
'* 機能 ：FATALエラー時の本処理内共通処理
'---------------------------------------------------------------------------------------------------
'* 返り値 ：(なし)
'* 引数 ：Arg1 = Err.Number(Integer)
'* Arg2 = Err.Description(String)
'* Arg3 = プロシージャ名(String)
'* Arg4 = オプション(String) ※Option
'* Arg5 = 発生箇所等(String) ※Option
'* Arg6 = 停止モード(Boolean) ※Option
'---------------------------------------------------------------------------------------------------
'* 作成日 ：2003年08月23日
'* 作成者 ：井上 治
'* 更新日 ：2020年01月09日
'* 更新者 ：井上 治
'* 機能説明：
'* 注意事項：
'***************************************************************************************************
Private Sub GP_FATAL_ERROR(ByVal intERR As Integer, _
ByVal strERR As String, _
ByVal strPROCNAME As String, _
Optional ByVal strMSG As String = "", _
Optional ByVal strLEVELNAME As String = "", _
Optional ByVal blnStopMode As Boolean = False)
'-----------------------------------------------------------------------------------------------
' エラーログ出力処理
' (ログファイル名､バージョン関連､処理タイトルはモジュール定数からセット､
' フォルダとユーザーはエラー処理側に一任)
Call modOutputFatalLog.OUTPUT_FATAL_LOG(intERR, _
strERR, _
"", _
g_cnsLOG_FILE, _
g_cnsVER, _
g_cnsVER_DATE, _
"", _
g_cnsTITLE, _
strPROCNAME, _
strLEVELNAME, _
strMSG, _
blnStopMode)
End Sub
このため、一旦中間で引数を編集し直す処理(このサンプルでは「GP_FATAL_ERROR」)を用意すると良いでしょう。こうすれば、各プロシージャでのエラー処理の記述が削減できます。
「ボタン１(型不一致)」から呼ばれるプロシージャです。
'***************************************************************************************************
' ■■■ シート上のボタン起動プロシージャ ■■■
'***************************************************************************************************
'* 処理名 ：Button1_Click
'* 機能 ：｢ボタン1(型不一致)｣ボタンクリック
'---------------------------------------------------------------------------------------------------
'* 返り値 ：(なし)
'* 引数 ：(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日 ：2003年08月23日
'* 作成者 ：井上 治
'* 更新日 ：2020年01月09日
'* 更新者 ：井上 治
'* 機能説明：わざとエラーを発生させる①
'* 注意事項：
'***************************************************************************************************
Sub Button1_Click()
'-----------------------------------------------------------------------------------------------
Const cnsPROCNAME = "Button1_Click"
Dim intNUM As Integer
Dim strCHAR As String
On Error GoTo Button1_ERROR
' ここでわざとエラーを発生させる
strCHAR = "ABC"
intNUM = CInt(strCHAR) ' ←文字列を数値変数に代入(エラーとなる)
' 終了
GoTo Button1_EXIT
'===================================================================================================
' エラートラップ
Button1_ERROR:
Dim strERR_TEXT As String
' プロシージャ内変数のスナップショットを編集
strERR_TEXT = " intNUM = " & intNUM & vbCrLf & " strCHAR = " & strCHAR
' LOG出力&エラー表示の呼び出し(共通処理を作成)
Call GP_FATAL_ERROR(Err.Number, Err.Description, cnsPROCNAME, strERR_TEXT)
'===================================================================================================
' 終了
Button1_EXIT:
' 保存済みにする
ThisWorkbook.Saved = True
End Sub
複数のプロシージャがあっても、ほとんど同じように記述するだけで済みます。
「strERR_TEXT」には、エラートラップした段階でログに出力する変数項目のスナップショットを編集します。プロシージャ内の変数はもちろんのこと、モジュールレベル変数でも重要なものはここに記述します。
「ボタン2(オーバーフロー)」から呼ばれるプロシージャです。
'***************************************************************************************************
'* 処理名 ：Button2_Click
'* 機能 ：｢ボタン2(オーバーフロー)｣ボタンクリック
'---------------------------------------------------------------------------------------------------
'* 返り値 ：(なし)
'* 引数 ：(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日 ：2003年08月23日
'* 作成者 ：井上 治
'* 更新日 ：2020年01月09日
'* 更新者 ：井上 治
'* 機能説明：わざとエラーを発生させる②
'* 注意事項：
'***************************************************************************************************
Sub Button2_Click()
'-----------------------------------------------------------------------------------------------
Const cnsPROCNAME = "Button2_Click"
Dim intNUM As Integer
Dim intNUM2 As Integer
Dim intNUM3 As Integer
Dim strLEBEL As String ' ﾌﾟﾛｼｰｼﾞｬ内の工程を表意(本来は長いﾌﾟﾛｼｰｼﾞｬで発生箇所特定のため)
On Error GoTo Button2_ERROR
' ここでわざとエラーを発生させる
strLEBEL = "intNUMのセット"
intNUM = 10000
strLEBEL = "intNUM2のセット"
intNUM2 = 100
strLEBEL = "intNUM3のセット"
intNUM3 = intNUM * intNUM2 ' ←桁あふれエラーとなる
' 終了
GoTo Button2_EXIT
'===================================================================================================
' エラートラップ
Button2_ERROR:
Dim strERR_TEXT As String
' プロシージャ内変数のスナップショットを編集
strERR_TEXT = " intNUM = " & intNUM & vbCrLf & " intNUM2 = " & intNUM2 & vbCrLf & _
" intNUM3 = " & intNUM3
' LOG出力&エラー表示の呼び出し(共通処理を作成)
Call GP_FATAL_ERROR(Err.Number, Err.Description, cnsPROCNAME, strERR_TEXT, strLEBEL)
'===================================================================================================
' 終了
Button2_EXIT:
' 保存済みにする
ThisWorkbook.Saved = True
End Sub
通常は、実行時エラーが発生すると、エラーログが出力された上でメッセージが表示されます。
この時点でマクロ自身は停止されてしまいますが、処理によっては「停止」が都合が悪い場合もあります。独自にエラーでの対処を行なう場合は、「blnStopMode」に「True」をセットします。この時は「OUTPUT_FATAL_LOG」はログ出力だけでエラーメッセージを表示せずに元処理に制御を戻します。
現在では、このログ出力機能と「アドイン化」を併用して運用させています。「アドイン」は共通サーバに置いておき、各所に配布したワークブックからは立ち上げのプロシージャでこの「アドイン」を呼び出して、以降は「アドイン」側のマクロで業務運用する仕組み(「配布の問題」で説明しています)です。
この「エラーログ出力」を併用すると、エラーログは「アドイン」が収容されている共通サーバのフォルダ配下の「LOG」フォルダに出力されるので、エラー発生場所を参照しなくても「アドイン」が置かれている場所にエラーログも集約されてくる利点があります。
以下が組み込み用のモジュール「modOutputFatalLog.bas」の記述です。
'***************************************************************************************************
' 共通画面制御＋FATALエラーログ出力 modOutputFatalLog(Module)
'
' 作成者:井上治 URL:https://www.ne.jp/asahi/excel/inoue/ [Excelでお仕事!]
'***************************************************************************************************
' [参照設定]
' ・Microsoft Scripting Runtime
' ・Windows Script Host Object Model
'***************************************************************************************************
'変更日付 Rev 変更履歴内容------------------------------------------------------------------------>
'03/08/23(1.00)新規作成
'19/10/28(1.10)64ビット版Office対応
'20/01/09(1.20)ダミー引数廃止(Option Private Module)、動作改善、ソース整理(標準化準拠)
'***************************************************************************************************
Option Explicit
Option Private Module
'===================================================================================================
' 64ビット版判定
#If VBA7 Then
' ■スリープ
Private Declare PtrSafe Sub Sleep Lib "KERNEL32.dll" _
(ByVal dwMilliseconds As Long)
#Else
' ■スリープ
Private Declare Sub Sleep Lib "KERNEL32.dll" _
(ByVal dwMilliseconds As Long)
#End If
'***************************************************************************************************
' ■■■ 公開プロシージャ(Public) ■■■
'***************************************************************************************************
'* 処理名 ：Stop_ScreenUpdating
'* 機能 ：画面描画更新停止
'---------------------------------------------------------------------------------------------------
'* 返り値 ：(なし)
'* 引数 ：(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日 ：2003年08月23日
'* 作成者 ：井上 治
'* 更新日 ：2020年01月09日
'* 更新者 ：井上 治
'* 機能説明：一括処理用に画面明滅､自動計算､イベント輻輳を回避する
'* 注意事項：
'***************************************************************************************************
Public Sub Stop_ScreenUpdating()
'-----------------------------------------------------------------------------------------------
With Application
.ScreenUpdating = False
' .EnableCancelKey = xlDisabled ' 必要であればコメントを解除して下さい
.Calculation = xlCalculationManual
' .Interactive = False ' 必要であればコメントを解除して下さい
.Cursor = xlWait
.EnableEvents = False
End With
End Sub
'***************************************************************************************************
'* 処理名 ：Start_ScreenUpdating
'* 機能 ：画面描画更新復帰
'---------------------------------------------------------------------------------------------------
'* 返り値 ：(なし)
'* 引数 ：Arg1 = StatusBar操作(Integer) ※0=通常(表示しない), 1=操作しない
'---------------------------------------------------------------------------------------------------
'* 作成日 ：2003年08月23日
'* 作成者 ：井上 治
'* 更新日 ：2003年08月23日
'* 更新者 ：井上 治
'* 機能説明：一括処理終了時に画面明滅､自動計算､イベント輻輳回避を復旧する
'* 注意事項：
'***************************************************************************************************
Public Sub Start_ScreenUpdating(Optional SW As Integer)
'-----------------------------------------------------------------------------------------------
With Application
.Calculation = xlCalculationAutomatic
.Cursor = xlDefault
.EnableCancelKey = xlInterrupt
.EnableEvents = True
.Interactive = True
If SW <> 1 Then .StatusBar = False
.ScreenUpdating = True
End With
End Sub
'***************************************************************************************************
'* 処理名 ：OUTPUT_FATAL_LOG
'* 機能 ：FATALエラーログ出力
'---------------------------------------------------------------------------------------------------
'* 返り値 ：(なし)
'* 引数 ：Arg1 = Err.Number(Integer)
'* Arg2 = Err.Description(String)
'* Arg3 = LOGファイルの収容フォルダ名(String)
'* Arg4 = LOGファイル名(String)
'* Arg5 = バージョン(String) ※任意、先頭の｢Ver｣は不要
'* Arg6 = バージョン更新日(String) ※任意
'* Arg7 = ユーザー名(String) ※未通知時はWindowsログインユーザー
'* Arg8 = 業務処理名(String) ※メニュー等の処理タイトル
'* Arg9 = エラー発生したプロシージャ名(String)
'* Arg10= プロシージャ内位置表意(String) ※任意
'* Arg11= 変数値等の説明(String) ※任意
'* Arg12= 停止モード(Boolean) ※True=表示のみ、False=表示後Endとする(Option)
'---------------------------------------------------------------------------------------------------
'* 作成日 ：2003年08月23日
'* 作成者 ：井上 治
'* 更新日 ：2020年01月09日
'* 更新者 ：井上 治
'* 機能説明：
'* 注意事項：収容フォルダ名の最終レベルは未作成なら自動作成される
'***************************************************************************************************
Public Sub OUTPUT_FATAL_LOG(ByVal intERR As Integer, _
ByVal strERR As String, _
ByVal strPathname As String, _
ByVal strFilename As String, _
ByVal strVer As String, _
ByVal strVER_DATE As String, _
ByVal strUSER As String, _
ByVal strTITLE As String, _
ByVal strPROCNAME As String, _
ByVal strLEVELNAME As String, _
ByVal strMSG As String, _
Optional ByVal blnStopMode As Boolean = False)
'-----------------------------------------------------------------------------------------------
Dim objFso As FileSystemObject ' FileSystemObject
Dim objTs As TextStream ' TextStream
Dim cntRETRY As Integer ' リトライカウンタ
Dim strFullname As String ' フルパスファイル名
Dim strERRMSG As String ' エラーメッセージ
Dim strPRINT_TEXT As String ' 出力レコード
Dim strVERSION As String ' バージョン情報
Dim strLOGIN As String ' ログインユーザー
Set objFso = New FileSystemObject
' フォルダ､ファイル名の編集
cntRETRY = 0
' パス名が指定されない場合は､本ブックのフォルダに｢LOG｣フォルダを作成
If strPathname = "" Then strPathname = ThisWorkbook.Path & "\LOG"
' 出力フォルダの存在を確認(ここでエラーとなる場合はLOGは出力されない)
On Error GoTo OUTPUT_LOG_EXIT
' 出力フォルダがなければ作成
If Not objFso.FolderExists(strPathname) Then
objFso.CreateFolder strPathname
End If
On Error GoTo 0
' メッセージ編集
strERRMSG = Format(intERR, "000") & " " & strERR
' ユーザーの編集
If strUSER <> "" Then
strLOGIN = strUSER
Else
' Windowsログイン名取得
strLOGIN = FP_GetWindowsLogin
End If
' 出力レコードの編集
strPRINT_TEXT = _
"[表示エラー] " & strERRMSG & vbCrLf & _
"[発生日時 ] " & Format$(Now, "YYYY/MM/DD hh:mm:ss") & vbCrLf & _
"[ファイル名] " & ActiveWorkbook.Name & vbCrLf
If ((strVer <> "") Or (strVER_DATE <> "")) Then
' バージョンの編集
strPRINT_TEXT = strPRINT_TEXT & "[バージョン] "
If strVer <> "" Then
strPRINT_TEXT = strPRINT_TEXT & "Ver" & strVer
End If
If strVER_DATE <> "" Then
strPRINT_TEXT = strPRINT_TEXT & "(" & strVER_DATE & ")"
End If
strPRINT_TEXT = strPRINT_TEXT & vbCrLf
End If
strPRINT_TEXT = strPRINT_TEXT & _
"[機器・環境] " & FP_GetComputerName & "(" & FP_GetOSVersion & ") " & _
FP_GetExcelVersion & vbCrLf & _
"[ユーザー名] " & strLOGIN & vbCrLf & _
"[処 理 名] " & strTITLE & vbCrLf & _
"[実行処理名] " & strPROCNAME & "(" & strLEVELNAME & ")" & vbCrLf
If strMSG <> "" Then
strPRINT_TEXT = strPRINT_TEXT & _
"[変数スナップショット等]" & vbCrLf & strMSG & vbCrLf & "----------" & vbCrLf
End If
' フルパスファイル名の編集
strFullname = objFso.BuildPath(strPathname, strFilename)
' LOGファイル出力(テキスト形式) ※10回以上の失敗は無視
On Error GoTo OUTPUT_LOG_ERROR
Set objTs = objFso.OpenTextFile(strFullname, ForAppending, True)
On Error GoTo 0
objTs.WriteLine strPRINT_TEXT
objTs.Close
' Skipモードでなければ本処理内で停止
If blnStopMode <> True Then
' 画面描画を再開
Call Start_ScreenUpdating
' 実行時エラーは上位に制御を戻さず終了(通常)
MsgBox strPROCNAME & "で実行時エラーが発生しました。" & vbCr & _
" (" & strERRMSG & ")" & vbCr & _
" ※エラーログが出力されました。", _
vbCritical, strTITLE
End
End If
GoTo OUTPUT_LOG_EXIT
'===================================================================================================
' OPEN不成功時のリトライWAIT
OUTPUT_LOG_ERROR:
cntRETRY = cntRETRY + 1
' リトライ数上限以内か
If cntRETRY <= 10 Then
Sleep Int(301 * Rnd + 200)
Resume
End If
'===================================================================================================
' 終了
OUTPUT_LOG_EXIT:
Set objFso = Nothing
On Error GoTo 0
End Sub
Public Function GetOSVersion() As String
End Function
'***************************************************************************************************
' ■■■ サブ処理(Private) ■■■
'***************************************************************************************************
'* 処理名 ：FP_GetOSVersion
'* 機能 ：Windowsのバージョンを返す
'---------------------------------------------------------------------------------------------------
'* 返り値 ：Windowsバージョン(String)
'* 引数 ：(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日 ：2003年08月23日
'* 作成者 ：井上 治
'* 更新日 ：2020年01月09日
'* 更新者 ：井上 治
'* 機能説明：
'* 注意事項：
'***************************************************************************************************
Private Function FP_GetOSVersion() As String
'-----------------------------------------------------------------------------------------------
Dim Locator As Object, Service As Object, OsSet As Object, os As Object, msg As String
Set Locator = CreateObject("WbemScripting.SWbemLocator")
Set Service = Locator.ConnectServer
Set OsSet = Service.ExecQuery("Select * From Win32_OperatingSystem")
For Each os In OsSet
msg = msg & os.Caption & " "
msg = msg & os.Version
Next os
FP_GetOSVersion = msg
Set Service = Nothing
Set OsSet = Nothing
Set Locator = Nothing
End Function
'***************************************************************************************************
'* 処理名 ：FP_GetComputerName
'* 機能 ：コンピュータ名を返す
'---------------------------------------------------------------------------------------------------
'* 返り値 ：コンピュータ名(String)
'* 引数 ：(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日 ：2003年08月23日
'* 作成者 ：井上 治
'* 更新日 ：2020年01月09日
'* 更新者 ：井上 治
'* 機能説明：
'* 注意事項：
'***************************************************************************************************
Private Function FP_GetComputerName() As String
'-----------------------------------------------------------------------------------------------
Dim objWshNetwork As IWshRuntimeLibrary.WshNetwork
Set objWshNetwork = New IWshRuntimeLibrary.WshNetwork
FP_GetComputerName = objWshNetwork.ComputerName
Set objWshNetwork = Nothing
End Function
'***************************************************************************************************
'* 処理名 ：FP_GetWindowsLogin
'* 機能 ：Windowsログイン名を返す
'---------------------------------------------------------------------------------------------------
'* 返り値 ：Windowsログイン名(String)
'* 引数 ：(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日 ：2003年08月23日
'* 作成者 ：井上 治
'* 更新日 ：2020年01月09日
'* 更新者 ：井上 治
'* 機能説明：
'* 注意事項：
'***************************************************************************************************
Private Function FP_GetWindowsLogin() As String
'-----------------------------------------------------------------------------------------------
Dim objWshNetwork As IWshRuntimeLibrary.WshNetwork
Set objWshNetwork = New IWshRuntimeLibrary.WshNetwork
FP_GetWindowsLogin = objWshNetwork.UserName
Set objWshNetwork = Nothing
End Function
'***************************************************************************************************
'* 処理名 ：FP_GetExcelVersion
'* 機能 ：Excelのバージョンを返す
'---------------------------------------------------------------------------------------------------
'* 返り値 ：Excelバージョン(String)
'* 引数 ：(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日 ：2003年08月23日
'* 作成者 ：井上 治
'* 更新日 ：2020年01月09日
'* 更新者 ：井上 治
'* 機能説明：
'* 注意事項：
'***************************************************************************************************
Public Function FP_GetExcelVersion() As String
'-----------------------------------------------------------------------------------------------
Dim strVerName As String
Dim strVer As String
strVer = Application.Version
Select Case Val(strVer)
Case 7: strVerName = "95"
Case 8: strVerName = "97"
Case 9: strVerName = "2000"
Case 10: strVerName = "2002"
Case 11: strVerName = "2003"
Case 12: strVerName = "2007"
Case 14: strVerName = "2010"
Case 15: strVerName = "2013"
Case 16: strVerName = "2016"
Case 17: strVerName = "2019"
Case Else: strVerName = strVer
End Select
FP_GetExcelVersion = "Excel" & strVerName
End Function
'------------------------------------------<< End of Source >>--------------------------------------
 |
←OutputFatalLog.zip (42KB) |