新建From1(窗体),新建Command1(按钮CommandButton),代码:
'Most API calls will return an error number indicating whether the call was successfully made or not. To convert these error numbers into more meaningful error messages use the following function:
'Error message API
Private Declare Function LoadLibraryEx Lib "kernel32" Alias "LoadLibraryExA" (ByVal lpLibFileName As String, ByVal hFile As Long, ByVal dwFlags As Long) As Long
Private Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long
Private Declare Function FormatMessage Lib "kernel32" Alias "FormatMessageA" (ByVal dwFlags As Long, ByVal lpSource As Long, ByVal dwMessageId As Long, ByVal dwLanguageId As Long, ByVal lpBuffer As String, ByVal nSize As Long, Arguments As Any) As Long
'Purpose : Converts an error number to an error description
'Inputs : lErrorNumber The API error number
'Outputs : Returns a descriptive error message
Function f_ErrorDescription(ByVal lErrorNumber As Long) As String
Const FORMAT_MESSAGE_FROM_HMODULE = &H800, FORMAT_MESSAGE_FROM_SYSTEM = &H1000
Const NERR_BASE = 2100, MAX_NERR = NERR_BASE + 899
Const LOAD_LIBRARY_AS_DATAFILE = &H2
Dim sMsg As String
Dim sRtrnCode As String
Dim lFlags As Long
Dim hModule As Long
Dim lRet As Long
hModule = 0
sRtrnCode = Space$(256)
lFlags = FORMAT_MESSAGE_FROM_SYSTEM
'If lRet is in the network range, load the message source
If (lErrorNumber >= NERR_BASE And lErrorNumber <= MAX_NERR) Then
hModule = LoadLibraryEx("netmsg.dll", 0&, LOAD_LIBRARY_AS_DATAFILE)
If (hModule <> 0) Then
lFlags = lFlags Or FORMAT_MESSAGE_FROM_HMODULE
End If
End If
'Call FormatMessage to allow for message text to be acquired
'from the system or the supplied module handle.
lRet = FormatMessage(lFlags, hModule, lErrorNumber, 0&, sRtrnCode, 256&, 0&)
If (hModule <> 0) Then
'Unloaded message source
FreeLibrary hModule
End If
f_ErrorDescription = "ERROR: " & lErrorNumber & " - " & sRtrnCode
'Clean message
lRet = InStr(1, f_ErrorDescription, vbNullChar)
If lRet Then
f_ErrorDescription = Left$(f_ErrorDescription, lRet - 1)
End If
lRet = InStr(1, f_ErrorDescription, vbNewLine)
If lRet Then
f_ErrorDescription = Left$(f_ErrorDescription, lRet - 1)
End If
End Function
Private Sub Command1_Click()
On Error GoTo hErr
Dim a As Integer
a = 1 / 0
Exit Sub
hErr:
Debug.Print Err.Description
Debug.Print f_ErrorDescription(Err.Number)
End Sub
运行结果:
除数为零
ERROR: 11 - 试图加载格式不正确的程序。