如何阻止excel运行所有错误

Question

我有以下代码来处理我的错误：

Sub some_sub()

    On Error GoTo error1
    Some code here

    On Error GoTo error2
    Some more code here

    On Error GoTo error3
    final piece of code here



Exit Sub

error1
    MsgBox "Claims followup.xlsm is not open." & Chr(10) & Chr(10) & "Open the file in read/write"

error2
    MsgBox "Please make sure that the Claims followup file is open." & Chr(10) & Chr(10) & "If the file is open make sure that you the Solicitation Number is written correctly."

error3
    MsgBox "Your Claim followup file is in -read only- mode. Your changes may not be saved"

End Sub

Sub some_sub()

    On Error GoTo error1
    Some code here

    On Error GoTo error2
    Some more code here

    On Error GoTo error3
    final piece of code here



Exit Sub

error1
    MsgBox "Claims followup.xlsm is not open." & Chr(10) & Chr(10) & "Open the file in read/write"

error2
    MsgBox "Please make sure that the Claims followup file is open." & Chr(10) & Chr(10) & "If the file is open make sure that you the Solicitation Number is written correctly."

error3
    MsgBox "Your Claim followup file is in -read only- mode. Your changes may not be saved"

End Sub

但是，当检测到“error1”时，它也会触发“error2”和“error3”，但我只希望它触发“error1”。如果“error2”触发“error3”也会触发。而当error3被触发时，它是唯一的，所以它从发现的错误开始从上到下运行。

我的问题是：如何更改此代码，使其仅触发错误之一？

提前感谢您的帮助。

Answer 1

尝试在消息框后添加一行Exit Sub。在 error1 的消息框之后继续执行。

所以它应该是这样的：

Exit Sub

error1
    MsgBox "Claims followup.xlsm is not open." & Chr(10) & Chr(10) & "Open the file in read/write"
    Exit Sub
error2
    MsgBox "Please make sure that the Claims followup file is open." & Chr(10) & Chr(10) & "If the file is open make sure that you the Solicitation Number is written correctly."
    Exit Sub
error3
    MsgBox "Your Claim followup file is in -read only- mode. Your changes may not be saved"
    Exit Sub
End Sub

Answer 2

如果您想区分错误，您可以使用Err.Number 来做到这一点，并捕获特定错误并相应地显示消息，因此在您的情况下应该是：

    `Sub some_sub()

        On Error GoTo errorHandler
        Some code here   


    Exit Sub
    errorHandler:
if Err.Number= Err no corresponds to Claims followup.xlsm is not open
    MsgBox "Claims followup.xlsm is not open." & Chr(10) & Chr(10) & "Open the file in read/write"
elseif Err.Number = Err no corresponds to Solicitation Number is written correctly
        MsgBox "Please make sure that the Claims followup file is open." & Chr(10) & Chr(10) & "If the file is open make sure that you the Solicitation Number is written correctly."    
elseif Err.Number = Err no corresponds to Claim followup file is in -read only- mode
        MsgBox "Your Claim followup file is in -read only- mode. Your changes may not be saved"

    End Sub

希望这会有所帮助！

Answer 3

首先尝试避免错误。对于意外错误，请在错误处理程序中使用Select...Case，并让代码在同一位置退出过程，以便执行所有必需的整理。

我添加了几个检查文件是否打开或存在的功能。

Sub some_sub()

    Dim x As Long
    Dim y As Long
    Dim wrkBk As Workbook
    Dim wrkSht As Workbook
    Dim sPath As String, sFile As String

    On Error GoTo ErrorHandler

        sPath = "C:\"
        sFile = "Claims followup.xlsm"

        'Avoid error by checking file exists and is open.
        If FileExists(sPath & sFile) Then

            'Avoided Error1 & 2 completely by checking if the file is open first.
            If WorkBookIsOpen(sPath & sFile) Then
                Set wrkBk = Workbooks(sFile)
            Else
                Set wrkBk = Workbooks.Open(sPath & sFile)
            End If

            'Avoid error 3 by checking if it's read only first.
            If Not wrkBk.ReadOnly Then

                'These all throw errors.
                x = "A"
                y = 0
                Debug.Print 20 / y

                Set wrkSht = ThisWorkbook.Worksheets("Non Existent Worksheet")

            End If

        End If

            On Error GoTo 0

SingleExitPoint:
    'Tidy up, close connections, etc....

Exit Sub

ErrorHandler:
    Select Case Err.Number
        Case 13 'Type Mismatch
            x = 0
            Resume Next 'Continue on the line following the error.
        Case 11 'Division by zero
            y = 2
            Resume 'Continue on the line that caused the error.
        Case 9 'Subscript out of range
            Resume SingleExitPoint

    End Select

End Sub

Public Function WorkBookIsOpen(FullFilePath As String) As Boolean

    Dim ff As Long

    On Error Resume Next

    ff = FreeFile()
    Open FullFilePath For Input Lock Read As #ff
    Close ff
    WorkBookIsOpen = (Err.Number <> 0)

    On Error GoTo 0

End Function

Public Function FileExists(ByVal FileName As String) As Boolean
    Dim oFSO As Object
    Set oFSO = CreateObject("Scripting.FileSystemObject")
    FileExists = oFSO.FileExists(FileName)
End Function