● API関数の戻り値からエラーメッセージを取得する ●

API関数のエラーメッセージを意識することなんてあまり無いかな? だが関心を持つべく エラーメッセージ一覧 を用意したぜ!!

まあ素晴らしいエラー関連のAPI関数が用意されているので知っておくのも良いかと。

Private Declare 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 Long) As Long

Private Declare Function GetLastError Lib "kernel32" () As Long

Private Const FORMAT_MESSAGE_ALLOCATE_BUFFER = &H100
Private Const FORMAT_MESSAGE_ARGUMENT_ARRAY = &H2000
Private Const FORMAT_MESSAGE_FROM_HMODULE = &H800
Private Const FORMAT_MESSAGE_FROM_STRING = &H400
Private Const FORMAT_MESSAGE_FROM_SYSTEM = &H1000
Private Const FORMAT_MESSAGE_IGNORE_INSERTS = &H200
Private Const FORMAT_MESSAGE_MAX_WIDTH_MASK = &HFF
Private Const LANG_USER_DEFAULT = &H400&

'---------------------------------------------------------------
' 関数名: GetErrorString
' 機能 : API関数の戻り値からエラーメッセージを取得する
' 引数 : (in) ApiErrorId … API関数の戻り値
' 返り値 :戻り値に対するエラーメッセージ
'---------------------------------------------------------------
Public Function GetErrorString(Optional ByVal ApiErrorId As Long = 0) As String

    Dim ErrMessage As String * 256
    Dim FuncRet As Long

    If ApiErrorId = 0 Then
        ApiErrorId = GetLastError()
    End If

    FuncRet = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM Or _
                            FORMAT_MESSAGE_IGNORE_INSERTS Or _
                            FORMAT_MESSAGE_MAX_WIDTH_MASK, _
                            ByVal 0&, ApiErrorId, LANG_USER_DEFAULT, _
                            ByVal ErrMessage, Len(ErrMessage), 0)
    If FuncRet Then GetErrorString = Left$(ErrMessage, FuncRet)

End Function

んで呼び出し側を用意。以下は存在しないファイルを実行するサンプル。コマンドボタンを貼り付けて、以下をコピペ。

Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

'ウインドウをアクティブにし、表示する
Private Const SW_SHOWNORMAL = 1

Private Sub Command1_Click()

    Dim FuncRet As Long

    FuncRet = ShellExecute(Me.hWnd, "open", "XXXXXX", vbNullString, "C:\", SW_SHOWNORMAL)
    If FuncRet < 32 Then
        Call MsgBox(GetErrorString(FuncRet), vbCritical, "ShellExecute関数 失敗")
    End If

End Sub

戻る