如果错误再次尝试VBA

时间:2017-08-22 09:22:14

标签: vba loops ms-access error-handling

我们使用SQL Server,Access和Excel自动化了报告流程。然而,我们的一个查询在早上运行有困难。有时会出现超时错误。发生这种情况时,整个系统崩溃,我们必须手动继续进程。

我希望添加一个VBA循环,以便在错误发生时允许查询再次尝试。

我希望系统能够:

  1. 运行查询。
  2. 如果失败,请等待5分钟再试一次。
  3. 如果连续5次失败,请停止代码。
  4. 我编写了以下代码,但我无法测试它。我希望你们中的任何一个人能够检查出来并评论它是否应该起作用。

        'Counter for the errors
        ErrorCount = 0
        GoTo CheckConnection
    
    CheckConnection:
        If ErrorCount < 6 Then
        'Try to execute the query
            db.Execute sqlq
            'If it fails, ignore the error message and go to BadConnection
            On Error GoTo BadConnection
        Else
        'If the query failed 5x, just give up and show the error message
            db.Execute sqlq
            Resume Next
            End If
    
    BadConnection:
        'Add +1 to the counter
            ErrorCount = ErrorCount + 1
            'Allow the application to wait for 5 minutes
            Application.Wait (Now + TimeValue("0:05:00"))
            'Try the query again
            GoTo CheckConnection
    

2 个答案:

答案 0 :(得分:1)

您没有在正确的位置恢复,它需要在错误处理代码中:

    'Counter for the errors
    ErrorCount = 0
    GoTo CheckConnection 'This statement is pointless if the label is directly after it

CheckConnection:
    'Try to execute the query

    ' This says to go to BadConnection if an error occurs after it,
    ' not if an error occurred previously
    On Error GoTo BadConnection
    db.Execute sqlq
    ' Start allowing errors to crash Excel again
    On Error GoTo 0
    'Query worked - continue processing
    '....

    '...
    Exit Sub

'Error handling code    
BadConnection:
    ' Start allowing errors to crash Excel again
    On Error GoTo 0
    If ErrorCount = 5 Then
        'If the query failed 5x, just give up and show the error message
        MsgBox "Giving up"
        Exit Sub
    End If
    'Add +1 to the counter
    ErrorCount = ErrorCount + 1
    'Allow the application to wait for 5 minutes
    Application.Wait (Now + TimeValue("0:05:00"))
    'Try the query again by Resuming at CheckConnection
    Resume CheckConnection

答案 1 :(得分:0)

使用递归可选参数可以解决这个问题:

Option Explicit

Public Sub TestMe(Optional errorCount As Long = 0)

    On Error GoTo TestMe_Error

    'Your code just to test it, make an error
    Debug.Print errorCount / 0

    On Error GoTo 0
    Exit Sub

TestMe_Error:

    Debug.Print "Error " & Err.Number & " (" & Err.Description & ") in procedure TestMe"
    errorCount = errorCount + 1

    Select Case errorCount

        Case 1, 2, 3
            Application.Wait Now + #12:05:00 AM#
            Call TestMe(errorCount)

        Case Else   'The 5th time it exits
            Exit Sub

    End Select

End Sub

使用递归来重新运行代码。重新运行代码的时间保存在参数errorCount中。因此,它退出的时间。

通常,请避免GoTo并仅将其用于错误处理。 GOTO still considered harmful?