这是我以前收藏的一段代码,供参考:
Option Explicit Public Const errBadFileNameOrNumber As Integer = 52 '不正确的文件名或文件号 Public Const errFileNotFound As Integer = 53 '文件未找到 Public Const errBadFileMode As Integer = 54 '文件类型不正确 Public Const errFileAlreadyOpen As Integer = 55 '文件已打开 Public Const errDeviceIO As Integer = 57 'I/O错 Public Const errFileAlreadyExists As Integer = 58 '文件已存在 Public Const errDiskFull As Integer = 61 '磁盘满 Public Const errInputPastEndOfFile As Integer = 62 '超越文件尾端 Public Const errBadFileName As Integer = 64 '文件名有误 Public Const errTooManyFiles As Integer = 67 '文件太多 Public Const errDeviceUnavailable As Integer = 68 '设备未准备好 Public Const errDiskNotReady As Integer = 71 '驱动器未准备好 Public Const errPathDoseNotExist As Integer = 76 '路径不存在 Function FileErrors(errVal As Integer) As Integer Dim MsgType As Integer, Response As Integer, Msg As String MsgType = vbExclamation Select Case errVal Case errDeviceUnavailable Msg = "磁盘未格式化或I/O出错" MsgType = vbExclamation + 5 Case errDiskNotReady Msg = "驱动器未准备好" Case errDeviceIO Msg = "磁盘满" Case errBadFileName, errBadFileNameOrNumber Msg = "文件名非法" Case errPathDoseNotExist Msg = "路径不存在" Case errBadFileMode Msg = "文件类型不正确,无法打开" Case errFileAlreadyOpen Msg = "文件已打开" Case errInputPastEndOfFile Msg = "有一个不正确遥文件结束标志,或企图越界读文件" Case Else FileErrors = 3 Exit Function End Select Response = MsgBox(Msg, MsgType, "出错处理") Select Case Response Case 1, 4 FileErrors = 0 Case 5 FileErrors = 1 Case 2, 3 FileErrors = 2 Case Else FileErrors = 3 End Select End Function Sub Example() Dim Action As Integer On Error GoTo ErrHandle Dir ("a:\") Exit Sub ErrHandle: Action = FileErrors(Err) Select Case Action Case 0 Resume Case Else Exit Sub End Select End Sub
|