DLL 関数のエラーメッセージの取得などに使用される FormatMessage 関数を、 VBA で使ってみる場合のメモです。
純粋な実装としては、この記事よりも以下の記事の方が適当だと思われます。
上記の記事では、処理の中でメモリ操作を行っています。
スマートに行うためには、メモリ操作を駆使した方が良いのですが、
- 使いたい環境ではコードの丸ごとコピーはできず、自身で実装する必要がある
- 自身がメモリ操作に不慣れ
といった点から、この記事ではメモリ操作に頼らない方法で実装しています。
Win32API_PtrSafe.TXT 内の記載
例によって、以下のページからダウンロードできる Win32API_PtrSafe.TXT 内の記載を引用します。
Office 2010 Help Files: Win32API_PtrSafe
Win32API_PtrSafe.TXT_2347-2355行目Declare PtrSafe Function FormatMessage Lib "kernel32" Alias "FormatMessageA" (ByVal dwFlags As Long, lpSource As Any, ByVal dwMessageId As Long, ByVal dwLanguageId As Long, ByVal lpBuffer As String, ByVal nSize As Long, Arguments As LongPtr) As Long Const FORMAT_MESSAGE_ALLOCATE_BUFFER = &H100 Const FORMAT_MESSAGE_IGNORE_INSERTS = &H200 Const FORMAT_MESSAGE_FROM_STRING = &H400 Const FORMAT_MESSAGE_FROM_HMODULE = &H800 Const FORMAT_MESSAGE_FROM_SYSTEM = &H1000 Const FORMAT_MESSAGE_ARGUMENT_ARRAY = &H2000 Const FORMAT_MESSAGE_MAX_WIDTH_MASK = &HFF
API 関数の定義と関連するフラグが定数で定義されています。
VBA で使いやすいように調整する
各フラグを列挙型にし、適宜改行を入れると以下のようになります。
Private Declare PtrSafe Function _
FormatMessage Lib "kernel32" Alias "FormatMessageA" ( _
ByVal dwFlags As FORMAT_MESSAGE_FLAGS, _
ByRef lpSource As Any, _
ByVal dwMessageId As Long, _
ByVal dwLanguageId As Long, _
ByVal lpBuffer As String, _
ByVal nSize As Long, _
ByRef Arguments As LongPtr _
) As Long
Private Enum FORMAT_MESSAGE_FLAGS
MAX_WIDTH_MASK = &HFF&
ALLOCATE_BUFFER = &H100& 'FormatMessage 側で文字列領域を割り当ててもらう(結果の取得には要メモリ操作)。
IGNORE_INSERTS = &H200&
FROM_STRING = &H400&
FROM_HMODULE = &H800&
FROM_SYSTEM = &H1000& 'システムからメッセージを取得する(DLL関数のエラー取得時など)
ARGUMENT_ARRAY = &H2000&
End Enum
DLL のエラーを取得する関数としてラップする
上記の定義を関数でラップして、DLL のエラーを取得する関数とします。
DLL のエラーを取得するためには以下の引数を渡す必要があります。
dwFlags
エラーメッセージの取得にはFROM_SYSTEMを指定する。
好みでMAX_WIDTH_MASKを追加しても可。
lpSource
FROM_STRINGやFROM_HMODULEを指定する場合に使用する。
今回は不要。
dwMessageId
DLL 関数のエラー Id を指定する。
API 関数のGetLastErrorでも取得できるが、VBA 側でErr.LastDllErrorが用意されているため、こちらを使った方が確実。
Private Declare PtrSafe Function _
GetLastError Lib "kernel32.dll" () As Long
dwLanguageId
言語の指定。
未指定(0)の場合、関数側である程度は勝手に判断してくれる。
lpBuffer
「エラーメッセージを格納するのに十分な大きさ」の文字列。
この「十分な大きさ」を見積もるのが難しい場合、dwFlagsにALLOCATE_BUFFERを指定するとで、FormatMessage側で領域を確保してくれる(結果の取得には要メモリ操作)。
nSize
lpBufferの大きさ。
Arguments
FROM_STRINGを指定する場合に使用する。
今回は不要。
最終的な関数
上記を踏まえて以下のような関数となりました。
引数未指定の場合は、最後の DLL 関数のエラーメッセージ。
任意の Id を指定すると、その Id に紐付けられたメッセージ。
'DLL 関数のエラーメッセージを取得する。
'dwMessageId :エラーメッセージの Id。省略時は Err.LastDllError が使用される。
Public Function GetDllErrorMessage( _
Optional ByVal dwMessageId As Long = 0 _
) As String
'引数省略対応。
If dwMessageId = 0 Then _
dwMessageId = VBA.Information.Err().LastDllError
'ALLOCATE_BUFFER を指定しないため、自前で領域を確保する。
Dim paddingSize As Long
paddingSize = &HFF
Const paddingChar = VBA.Constants.vbNullChar
Dim apiResult As Long
Do
'メッセージ用の領域確保。
Dim lpBuffer As String
lpBuffer = VBA.Strings.String$(paddingSize, paddingChar)
Dim nSize As Long
nSize = VBA.Strings.Len(lpBuffer)
apiResult = FormatMessage( _
FROM_SYSTEM Or MAX_WIDTH_MASK, _
0, _
dwMessageId, _
0, _
lpBuffer, _
nSize, _
0)
'失敗時(≒領域不足時)は 0 になる。
If apiResult <> 0 Then _
Exit Do
'確保サイズを大きくして再トライ。
paddingSize = paddingSize * 2
Loop
'必要な範囲だけ取得して出力(apiResult の結果そのままは使いにくい)。
Let GetDllErrorMessage = VBA.Strings.Left$(lpBuffer, VBA.Strings.InStr(1, lpBuffer, paddingChar) - 1)
End Function
imihito_Sandbox/M_GetDllErrorMessage.bas at master · imihito/imihito_Sandbox
参考
Download Office 2010 Help Files: Win32API_PtrSafe with 64-bit Support from Official Microsoft Download Center
FormatMessage function (winbase.h) | Microsoft Docs
VBAでAPI呼び出し時のエラー番号をFormatMessageを使って、エラーメッセージに変換する。 - Qiita
API関数使用時のエラー情報を取得(VB6.0) - VBレスキュー(花ちゃん)
関連記事
VBAでWindowsAPIを使うには - Qiita
カラーダイアログボックスを表示する（MS Office用・Win32API） - Qiita
[VBA]広域変数を使用せずに、EnumChildWindowsの結果を取得する - Qiita