More than 3 years have passed since last update.

FormatMessage で DLL 関数のエラーメッセージを取得する

Last updated at 2020-04-29Posted at 2019-04-04

DLL 関数のエラーメッセージの取得などに使用される FormatMessage 関数を、 VBA で使ってみる場合のメモです。

純粋な実装としては、この記事よりも以下の記事の方が適当だと思われます。

VBAでAPI呼び出し時のエラー番号をFormatMessageを使って、エラーメッセージに変換する。 - Qiita

上記の記事では、処理の中でメモリ操作を行っています。
スマートに行うためには、メモリ操作を駆使した方が良いのですが、

使いたい環境ではコードの丸ごとコピーはできず、自身で実装する必要がある
自身がメモリ操作に不慣れ

といった点から、この記事ではメモリ操作に頼らない方法で実装しています。

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 で使いやすいように調整する

各フラグを列挙型にし、適宜改行を入れると以下のようになります。

```vb
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