number - vba manejo de errores en bucle

on error vba

Question

Nuevo en vba, probando un ''on error goto'', pero sigo obteniendo el ''índice de errores fuera de rango''.

Solo quiero hacer un cuadro combinado que se rellena con los nombres de las hojas de cálculo que contienen una consulta.

    For Each oSheet In ActiveWorkbook.Sheets
        On Error GoTo NextSheet:
         Set qry = oSheet.ListObjects(1).QueryTable
         oCmbBox.AddItem oSheet.Name

NextSheet:
    Next oSheet

No estoy seguro de si el problema está relacionado con anidar el GoTo de error dentro de un bucle o cómo evitar el uso del bucle.

Answer 1

¿Qué pasa?

If oSheet.QueryTables.Count > 0 Then
  oCmbBox.AddItem oSheet.Name
End If 

O

If oSheet.ListObjects.Count > 0 Then
    ''// Source type 3 = xlSrcQuery
    If oSheet.ListObjects(1).SourceType = 3 Then
         oCmbBox.AddItem oSheet.Name
    End IF
End IF

Answer 2

Como una forma general de manejar el error en un bucle como su código de muestra, preferiría usar:

on error resume next
for each...
    ''do something that might raise an error, then
    if err.number <> 0 then
         ...
    end if
 next ....

Answer 3

El problema probablemente es que no se ha reanudado desde el primer error. No puedes lanzar un error desde dentro de un controlador de errores. Debe agregar una declaración de reanudación, algo como lo siguiente, para que VBA ya no piense que está dentro del controlador de errores:

For Each oSheet In ActiveWorkbook.Sheets
    On Error GoTo NextSheet:
     Set qry = oSheet.ListObjects(1).QueryTable
     oCmbBox.AddItem oSheet.Name
NextSheet:
    Resume NextSheet2
NextSheet2:
Next oSheet

Answer 4

En realidad, la respuesta de Gabin Smith debe cambiarse un poco para que funcione, porque no se puede continuar sin un error.

Sub MyFunc()
...
    For Each oSheet In ActiveWorkbook.Sheets
        On Error GoTo errHandler:
        Set qry = oSheet.ListObjects(1).QueryTable
        oCmbBox.AddItem oSheet.name

    ...
NextSheet:
    Next oSheet

...
Exit Sub

errHandler:
Resume NextSheet        
End Sub

Answer 5

Esta

On Error GoTo NextSheet:

Debiera ser:

On Error GoTo NextSheet

La otra solución también es buena.

Answer 6

Hay otra forma de controlar el manejo de errores que funciona bien para los bucles. Cree una variable de cadena llamada here y use la variable para determinar cómo un solo controlador de errores maneja el error.

La plantilla de código es:

On error goto errhandler

Dim here as String

here = "in loop"
For i = 1 to 20 
    some code
Next i

afterloop:
here = "after loop"
more code

exitproc:    
exit sub

errhandler:
If here = "in loop" Then 
    resume afterloop
elseif here = "after loop" Then
    msgbox "An error has occurred" & err.desc
    resume exitproc
End if

Answer 7

No quiero crear controladores de errores especiales para cada estructura de bucle en mi código, por lo que tengo una manera de encontrar bucles de problemas usando mi controlador de errores estándar para que luego pueda escribir un controlador de errores especial para ellos.

Si se produce un error en un bucle, normalmente quiero saber qué causó el error en lugar de simplemente omitirlo. Para averiguar sobre estos errores, escribo mensajes de error en un archivo de registro, como hacen muchas personas. Sin embargo, escribir en un archivo de registro es peligroso si se produce un error en un bucle, ya que el error se puede activar cada vez que el bucle se repite y, en mi caso, 80 000 iteraciones no son infrecuentes. Por lo tanto, puse algo de código en mi función de registro de errores que detecta errores idénticos y omite escribirlos en el registro de errores.

Mi controlador de errores estándar que se utiliza en cada procedimiento se ve así. Registra el tipo de error, el procedimiento en el que se produjo el error y los parámetros que recibió el procedimiento (FileType en este caso).

procerr:
    Call NewErrorLog(Err.number, Err.Description, "GetOutputFileType", FileType)
    Resume exitproc

Mi función de registro de errores que escribe en una tabla (estoy en ms-access) es la siguiente. Utiliza variables estáticas para conservar los valores anteriores de los datos de error y compararlos con las versiones actuales. El primer error se registra, luego el segundo error idéntico empuja la aplicación al modo de depuración si yo soy el usuario o si en otro modo de usuario, cierra la aplicación.

Public Function NewErrorLog(ErrCode As Variant, ErrDesc As Variant, Optional Source As Variant = "", Optional ErrData As Variant = Null) As Boolean
On Error GoTo errLogError

    ''Records errors from application code
    Dim dbs As Database
    Dim rst As Recordset

    Dim ErrorLogID As Long
    Dim StackInfo As String
    Dim MustQuit As Boolean
    Dim i As Long

    Static ErrCodeOld As Long
    Static SourceOld As String
    Static ErrDataOld As String

    ''Detects errors that occur in loops and records only the first two.
    If Nz(ErrCode, 0) = ErrCodeOld And Nz(Source, "") = SourceOld And Nz(ErrData, "") = ErrDataOld Then
        NewErrorLog = True
        MsgBox "Error has occured in a loop: " & Nz(ErrCode, 0) & Space(1) & Nz(ErrDesc, "") & ": " & Nz(Source, "") & "[" & Nz(ErrData, "") & "]", vbExclamation, Appname
        If Not gDeveloping Then  ''Allow debugging
            Stop
            Exit Function
        Else
            ErrDesc = "[loop]" & Nz(ErrDesc, "")  ''Flag this error as coming from a loop
            MsgBox "Error has been logged, now Quiting", vbInformation, Appname
            MustQuit = True  ''will Quit after error has been logged
        End If
    Else
        ''Save current values to static variables
        ErrCodeOld = Nz(ErrCode, 0)
        SourceOld = Nz(Source, "")
        ErrDataOld = Nz(ErrData, "")
    End If

    ''From FMS tools pushstack/popstack - tells me the names of the calling procedures
    For i = 1 To UBound(mCallStack)
        If Len(mCallStack(i)) > 0 Then StackInfo = StackInfo & "/" & mCallStack(i)
    Next

    ''Open error table
    Set dbs = CurrentDb()
    Set rst = dbs.OpenRecordset("tbl_ErrLog", dbOpenTable)

    ''Write the error to the error table
    With rst
        .AddNew
        !ErrSource = Source
        !ErrTime = Now()
        !ErrCode = ErrCode
        !ErrDesc = ErrDesc
        !ErrData = ErrData
        !StackTrace = StackInfo
        .Update
        .BookMark = .LastModified
        ErrorLogID = !ErrLogID
    End With


    rst.Close: Set rst = Nothing
    dbs.Close: Set dbs = Nothing
    DoCmd.Hourglass False
    DoCmd.Echo True
    DoEvents
    If MustQuit = True Then DoCmd.Quit

exitLogError:
    Exit Function

errLogError:
    MsgBox "An error occured whilst logging the details of another error " & vbNewLine & _
    "Send details to Developer: " & Err.number & ", " & Err.Description, vbCritical, "Please e-mail this message to developer"
    Resume exitLogError

End Function

Tenga en cuenta que un registrador de errores debe ser la función más protegida contra balas en su aplicación, ya que la aplicación no puede manejar los errores en el registrador de errores. Por este motivo, uso NZ () para asegurarme de que no se puedan introducir nulos. Tenga en cuenta que también agrego [loop] al segundo error idéntico para que sepa buscar primero los bucles en el procedimiento de error.

Answer 8

Qué tal si:

    For Each oSheet In ActiveWorkbook.Sheets
        If oSheet.ListObjects.Count > 0 Then
          oCmbBox.AddItem oSheet.Name
        End If
    Next oSheet