【EXCEL VBA】Winerror.hの内容一覧を一覧表にするマクロ

「MakeErrorCodeList.zip」をダウンロード

FormatMessage（エラーコードから内容を引くAPI）を利用して、エラーコード一覧を取得するマクロ。

サンプル結果として、自分のPC（Windows8　64bit）の結果も添付。

エラー調査するときに、手元にエラーコード一覧（早見表）があると便利なので作成。

各々のPC環境でこのマクロを実行すれば、その環境のエラー一覧ができるはず。

サンプルコード

Option Explicit
   
Public Const FORMAT_MESSAGE_ALLOCATE_BUFFER As Long = &H100
Public Const FORMAT_MESSAGE_ARGUMENT_ARRAY As Long = &H2000
Public Const FORMAT_MESSAGE_FROM_HMODULE As Long = &H800
Public Const FORMAT_MESSAGE_FROM_STRING As Long = &H400
Public Const FORMAT_MESSAGE_FROM_SYSTEM As Long = &H1000
Public Const FORMAT_MESSAGE_IGNORE_INSERTS As Long = &H200
Public Const FORMAT_MESSAGE_MAX_WIDTH_MASK As Long = &HFF
   
#If VBA7 Then
Public Declare PtrSafe Function FormatMessage Lib "kernel32" Alias _
      "FormatMessageA" (ByVal dwFlags As Long, lpSource As Long, _
      ByVal dwMessageId As Long, ByVal dwLanguageId As Long, _
      ByVal lpBuffer As String, ByVal nSize As Long, Arguments As Any) _
      As Long

Private Declare PtrSafe Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFOEX) As Long

#Else
Public Declare Function FormatMessage Lib "kernel32" Alias _
      "FormatMessageA" (ByVal dwFlags As Long, lpSource As Long, _
      ByVal dwMessageId As Long, ByVal dwLanguageId As Long, _
      ByVal lpBuffer As String, ByVal nSize As Long, Arguments As Any) _
      As Long

Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFOEX) As Long

#End If

Private Type OSVERSIONINFOEX
    dwOSVersionInfoSize As Long
    dwMajorVersion      As Long
    dwMinorVersion      As Long
    dwBuildNumber       As Long
    dwPlatformId        As Long
    szCSDVersion        As String * 128
End Type

Private Function GetOSVersion()
    Dim lpVerInfo As OSVERSIONINFOEX
    lpVerInfo.dwOSVersionInfoSize = Len(lpVerInfo)
    Dim Result As Long
    Result = GetVersionEx(lpVerInfo)
    If Result = 0 Then Exit Function
    
    GetOSVersion = CStr(lpVerInfo.dwMajorVersion) + "." + CStr(lpVerInfo.dwMinorVersion) + " " + CStr(lpVerInfo.dwBuildNumber)
End Function

Public Function GetErrorMessage(ByVal dwMessageId As Long) As String

    Dim dwFlags As Long    ‘オプションフラグ
    Dim lpBuffer As String ‘メッセージを格納するたのバッファ
    Dim Result As Long     ‘戻り値(文字列のバイト数)
   
    dwFlags = FORMAT_MESSAGE_FROM_SYSTEM Or FORMAT_MESSAGE_IGNORE_INSERTS Or FORMAT_MESSAGE_MAX_WIDTH_MASK
    lpBuffer = String(1024, vbNullChar)
    Result = FormatMessage(dwFlags, 0&, dwMessageId, 0&, lpBuffer, Len(lpBuffer), 0&)
    If (Result > 0) Then
        lpBuffer = Left(lpBuffer, InStr(lpBuffer, vbNullChar) – 1)
    Else
        lpBuffer = ""
    End If
   
    GetErrorMessage = lpBuffer
End Function

Sub Sample()
    On Error GoTo EXCEPTION
    Dim i As Long
    Dim str As String
    Dim r As Range: Set r = Sheets("Sheet1").Range("A1")
   
    ‘ヘッダ行
    r.Value = "ヘキサ表示（VB用）"
    r.Offset(0, 1).Value = "ヘキサ表示"
    r.Offset(0, 2).Value = "内容(OSバージョン=" & GetOSVersion & ")"
    Set r = r.Offset(1, 0)
   
    For i = 0 To 65535
        str = GetErrorMessage(i)
        If str <> "" Then
            Debug.Print "&H" & Hex(i) & str
            
            r.Value = "&H" & Hex(i)
‘            r.Offset(0, 1).Value = "0x" & Hex(i)
            r.Offset(0, 1).Value = "0x" & Right("00000000" & Hex(i), 8)
            r.Offset(0, 2).Value = str
            Set r = r.Offset(1, 0)
            DoEvents
        End If
    Next i
       
    MsgBox "完了"
       
    Exit Sub
EXCEPTION:
    MsgBox Err.Description
End Sub

アウトプット（一部）

ヘキサ表示（VB用） ヘキサ表示 内容(OSバージョン=6.2 9200)
&H0 0x00000000 この操作を正しく終了しました。
&H1 0x00000001 ファンクションが間違っています。
&H2 0x00000002 指定されたファイルが見つかりません。
&H3 0x00000003 指定されたパスが見つかりません。
&H4 0x00000004 ファイルを開くことができません。
&H5 0x00000005 アクセスが拒否されました。
&H6 0x00000006 ハンドルが無効です。
&H7 0x00000007 記憶域制御ブロックが壊れています。
&H8 0x00000008 このコマンドを実行するための十分な記憶域がありません。
&H9 0x00000009 記憶域制御ブロックのアドレスが無効です。
&HA 0x0000000A 環境が間違っています。
&HB 0x0000000B 間違ったフォーマットのプログラムを読み込もうとしました。