VBA, Обработка ошибок, Переполнение стека, Ошибка, выданная после 2-го прохода L oop

Question

У меня возникла проблема с фактическим переполнением стека в моем коде VBA.

Я пытаюсь выяснить, как обрабатывать ошибки VBA.

Я создал тестовую подпрограмму, чтобы помочь выяснить это.

У меня есть сообщение об ошибке GoTo Error_Handle

Я хочу, если Err.Number = 13 Начать сначала, а не возобновить следующее.

Если я попытаюсь l oop GoTo Start_Over_Label :, на втором проходе ошибка по-прежнему выдается.

Если я попытаюсь l oop снова вызвать сабвуфер, я получу ошибку переполнения стека.

Есть ли какой-то способ l oop в сабвуфере, не выбрасывая ошибку или не поглощая стек вызовов?

Может быть, есть способ возобновить следующее, но запустить саб снова?

Я чувствую, что решение есть, но мне его не хватает.

Заранее спасибо

Private My_Long As Long
Private My_Err_Counter As Long

Private Function My_Timer(My_Delay As Long)

    Dim My_Timer_Counter As Long
    While My_Timer_Counter <= My_Delay
        DoEvents
        My_Timer_Counter = My_Timer_Counter + 1
    Wend

End Function

Sub My_Error_Test()
My_Start_Over:
    On Error GoTo My_Error_Handle
    My_Timer (200)

    My_Long = "as"
    MsgBox My_Long

My_Error_Handle:
    Debug.Print "Err Num: " & Err.Number & " - " & Err.Description
    Debug.Print My_Err_Counter
    My_Err_Counter = My_Err_Counter + 1
    If Err.Number = 13 Then
        Err.Clear
        GoTo My_Start_Over
    End If
End Sub

Answer 1

Ключевой вопрос заключается в том, что вы должны использовать Resume My_Start_Over вместо GoTo My_Start_Over. GoTo не сбрасывает обработку ошибок

Другие проблемы, которые вы могли бы решить

• Обычно у вас есть Exit Sub для обработчика ошибок. Без него код обработчика ошибок будет выполняться, когда Sub достигнет этой точки.
• Не используйте () вокруг параметров для Sub (если вы не хотите переопределить ByRef параметры ByVal
• While / Wend устарели. Используйте Do While Loop вместо
• Локальные параметры предпочтительнее
• Я добавил некоторый код, чтобы ваш тест в конечном итоге завершился

Private Function My_Timer(My_Delay As Long)
    Dim My_Timer_Counter As Long

    Do While My_Timer_Counter <= My_Delay
        DoEvents
        My_Timer_Counter = My_Timer_Counter + 1
    Loop
End Function

Sub My_Error_Test()
    Dim My_Long As Long
    Dim My_Err_Counter As Long
    Dim v As Variant
    v = "as"

My_Start_Over:

    On Error GoTo My_Error_Handle
    My_Timer 200
    If My_Err_Counter > 100 Then v = 1

    My_Long = v
    MsgBox My_Long
    My_Err_Counter = 0
Exit Sub
My_Error_Handle:
    Debug.Print "Err Num: " & Err.Number & " - " & Err.Description
    Debug.Print My_Err_Counter
    My_Err_Counter = My_Err_Counter + 1
    If Err.Number = 13 Then
        Err.Clear
        Resume My_Start_Over
    End If
End Sub