如题!

解决方案 »

  1.   

    用一下 on error goto
    Private Sub Command1_Click()
        On Error GoTo er
        '……
        '……
        '……
        Exit Sub
    er:
        MsgBox "运行过程中出错" '这里的文字你自己随便写
    End Sub
      

  2.   

    Private Sub Command1_Click()
        On Error GoTo er
        '……
        '……
        '……
        Exit Sub
    er:
        MsgBox "运行过程中出错" '这里的文字你自己随便写
    End Sub
      

  3.   

    Option ExplicitPrivate Sub Form_Load()
    On Error GoTo errSub
        
        Exit Sub
    errSub:
        MsgBox "装在窗体出错,错误号:" & Err.Number & ";错误描述:" & Err.Description, vbOKOnly + vbExclamation
    End Sub
      

  4.   

    On Error GoTo e 
    e: 
        MsgBox"装在窗体出错,错误号:"& Err.Number&";错误描述:"& Err.Description, vbOKOnly+ vbExclamation
      

  5.   

    给你看看我的出错处理例子Public Function DownLoadFile(ByRef sURL As String, ByRef SaveFile As String, ByVal GlobalRootPath As String, ByVal GlobalKMLPath As String) As Boolean
            '<EhHeader>
            On Error GoTo DownLoadFile_Err
            '</EhHeader>
            
            '下载之前需要处理地址
            Dim bGISInit    As Boolean
            Dim lRet        As Long
            
            If dictDownLoadFile Is Nothing Then
                Set dictDownLoadFile = New Scripting.Dictionary
            End If
            
    100     sURL = LTrim$(sURL)
    102     If LCase(Left(sURL, 4)) = "http" Or LCase(Left(sURL, 4)) = "file" Then
            Else
    104         If Left$(sURL, 1) = "/" Then
    106             sURL = GlobalRootPath & Right(sURL, Len(sURL) - 1)
    108         ElseIf mID(sURL, 2, 1) = ":" Then
                    'sUrl = sUrl
                Else
            
    110             sURL = GlobalKMLPath & sURL
                End If
            End If
        
            '避免重复下载,使用缓冲
    112     If dictDownLoadFile.Exists(sURL) = False Then
    114         GoSub labDownLoad
            Else
    116         SaveFile = dictDownLoadFile.Item(sURL)
    118         If Dir(SaveFile, vbNormal) <> "" Then
                
    120             DownLoadFile = True
                Else
    122             GoSub labDownLoad
                End If
            End If
            DownLoadFile = True
            GoTo FunctionEnd:
        
    labDownLoad:
            'On Error Resume Next
            
            '如果存在该文件则先删除
            If Dir(SaveFile) <> "" Then
                FileSystem.Kill SaveFile
            End If
            If Err.Number <> 0 Then
                
            End If
            Randomize
            If InStr(sURL, "?") > 0 Then
                lRet = URLDownloadToFile(0, sURL & "&showen=" & Rnd, SaveFile, 0, 0)
            Else
                lRet = URLDownloadToFile(0, sURL & "?showen=" & Rnd, SaveFile, 0, 0)
            End If
    128     'DownLoadFile = m_Download.DownloadFileWaitReturn(sURL, SaveFile)
        
    130     If Dir(SaveFile, vbNormal) <> "" Then 'DownLoadFile Then
    156         If dictDownLoadFile.Exists(sURL) = False Then
    158             dictDownLoadFile.Add sURL, SaveFile
                End If
            Else '下载失败使用默认图片162         If dictDownLoadFile.Exists(sURL) = False Then
    164             dictDownLoadFile.Add sURL, SaveFile
                End If
            End If
    166     Return        '<EhFooter>
            GoTo FunctionEndDownLoadFile_Err:
            DownLoadFile = False
            fMsgboxExp err.Number, err, err.description, _
                       "ModuleFunction.DownLoadFile Error by " & Erl & " Line"
            GoTo FunctionEnd
            Resume
    FunctionEnd:
            '</EhFooter>
    End FunctionfMsgboxExp 是自定义消息弹出函数
      

  6.   

    Private Sub Command1_Click()
        On Error GoTo er
        '……
        '……
        '……
        Exit Sub
    er:
        MsgBox "运行过程中出错" '这里的文字你自己随便写
    End Sub
      

  7.   

    其实说白了就是  用到了 onerror goto**挺基础的,就是捕捉到了错误,就goto了。
      

  8.   

    可能出错的地方都写上on error goto xxx
      

  9.   

    我习惯在生成程序的时候把每一句加上ON ERROR RESUME NEXT
    当然调试的时候不建议这么加,因为会跳过很多要处理的未知错误!
      

  10.   

    rem 自己写的集中错误处理模块:
    rem 用法: Call InitProErr(err,"自定义错误源",调试模式)
    rem 自己再改改,希望你能看懂-_-|||
    rem 说明:这个模块会保存一个日志,以供分析。Public Function InitProErr(ByRef ErrObj As ErrObject, ByVal ErrSource As String, ByVal IsDebug As Boolean) As Boolean
    Rem Transfer arglist to ProErr
        InitProErr = False
        InitProErr = Core(ErrObj, IsDebug, ErrSource)
    End FunctionPrivate Function Core(ByRef ErrObj As ErrObject, ByVal IsDebug As Boolean, ByVal ErrSource As String) As Boolean
        
        Dim Bdy As String, Hed As String, NF As Integer, tmp As String, K As Boolean
        
            tmp = "lc=" & App.Path & "\" & App.EXEName & ".exe"
            tmp = tmp & " pi=" & App.PrevInstance
            tmp = tmp & " pn=" & App.ProductName
            tmp = tmp & " vr=" & App.Major & "," & App.Minor & "," & App.Revision
            tmp = tmp & " nm=" & ErrObj.Number
            tmp = tmp & " es=" & ErrObj.Source
            tmp = tmp & " ps=" & ErrSource
            tmp = tmp & " dt=" & Now    If IsDebug = True Then        Hed = "调试模式-已识别的错误-集中错误处理程序"
            Bdy = ErrObj.Number & vbCrLf & ErrObj.Description & vbCrLf & "ObjSor " & ErrObj.Source & vbCrLf & "StrSor " & ErrSource
            Core = False
            Select Case ErrObj.Number
                Case 11
                    Core = True
                    K = True
                Case Else
                    Hed = "调试模式-未识别的错误-集中错误处理程序"
                    K = False
            End Select
            Dim tmpFileName As String
            NF = FreeFile
            tmp = tmp & " kn=" & K
            tmpFileName = Date & "_" & CLng(Timer)
            Open App.Path & "\错误报告debug" & tmpFileName & ".txt" For Random Access Read Write Lock Read Write As NF Len = 32767
            Put NF, , tmp
            Close NF
            NF = 0    Else        Hed = "错误"
            Core = False
            Select Case ErrObj.Number
                Case 11
                    Core = True
                    Bdy = "错误解释:" & "假装除以零" & vbCrLf
                    K = True
                Case Else
                    Hed = "未知错误"
                    Bdy = ""
                    K = False
            End Select
            tmp = tmp & " kn=" & K
            Bdy = "“" & App.ProductName & "”运行时遇到了问题,我们对此表示抱歉。" & vbCrLf & "如果您正在工作,未保存的信息有可能丢失。" & vbCrLf & Bdy & "请将以下信息或程序目录下的“错误报告.report”发送到<邮箱>中,谢谢!"
            NF = FreeFile
            Open App.Path & "\错误报告.report.txt" For Random Access Read Write Lock Read Write As NF Len = 32767
            Put NF, , tmp
            Close NF
            NF = 0
            Bdy = Bdy & vbCrLf & tmp    End If    MsgBox Bdy, vbOKOnly + vbSystemModal + vbCritical, Hed
        ErrObj.ClearEnd Function
      

  11.   

    有问题给我发邮件:[email protected]
      

  12.   

    建议用一个全局函数来处理错误!
    如下:
    '错误处理中心
    '
    '参数:
    '   oErr        必选。表示错误的对象
    '   sCaption    必选。表示标题
    '   eInfoStyle  可选。表示信息的样式(vbCritical、vbInformation 及 vbExclamation)
    '返回值:
    '   暂无
    Public Function iErrorManageentCenter(ByVal oErr As Object, ByVal sCaption As String, Optional ByVal eInfoStyle As VbMsgBoxStyle = vbInformation) As Long
        If (MsgBox("执行操作时发生未预期错误。" & vbCrLf & "详细信息:" & oErr.Description & " <" & CStr(oErr.Number) & ">", vbOKCancel + eInfoStyle, sCaption) = vbOK) Then
            '可以在此加入写入日志的代码……
        End If
    End FunctionPrivate Sub mySub()
    On Error GoTo userErr    '
        '您的代码...
        '
        Exit SubuserErr:
        '出错后由“错误处理中心”来处理
        Call iErrorManageentCenter(Err, Me.Caption, vbExclamation)
    End Sub