APIError

Call APIError
Debug.Print ReturnAPIError(53)
'Module Filename : APIError.bas

Option Explicit
Private Const FORMAT_MESSAGE_FROM_SYSTEM = &H1000
Private Const FORMAT_MESSAGE_IGNORE_INSERTS = &H200
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
Public Const INVALID_HANDLE_VALUE = -1&
Public Const ERROR_SUCCESS = 0&
Public Function ReturnAPIError(ErrorCode As Long) As String
Dim sBufferAs String
'Allocate the string, then get the system to tell us the

'error message associated with this error number

sBuffer = String(256, 0)
FormatMessage FORMAT_MESSAGE_FROM_SYSTEM Or _
FORMAT_MESSAGE_IGNORE_INSERTS,0&, ErrorCode, 0&, _
sBuffer, Len(sBuffer), 0&
'Strip the last null, then the last CrLf pair if it exists

sBuffer = Left(sBuffer, InStr(sBuffer, vbNullChar) - 1)
If Right$(sBuffer, 2) = Chr$(13) & Chr$(10) Then
sBuffer = Mid$(sBuffer, 1, Len(sBuffer) - 2)
End If
ReturnAPIError = sBuffer
End Function

Public Sub APIError()
Dim sErrorAs String
On Error Goto ERROR_APIError
sError = InputBox("Enter the error number", "Returns API error")
If IsNumeric(sError) = False Then Exit Sub
MsgBox ReturnAPIError(CLng(sError)), vbInformation + vbOKOnly, _
"Error n " & sError
Exit Sub
ERROR_APIError:
MsgBox "Error n " & sError & vbCrLf & _
"Invalid error number" & vbCrLf & _
"You have to give another one", _
vbCritical + vbOKOnly, "Error n " & sError
End Sub