2011-10-04 37 views
15

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

Solo quiero hacer un cuadro combinado que se llene con los nombres de las hojas de trabajo 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 la anidación On Error GoTo dentro de un bucle, o cómo evitar el uso del bucle.

Respuesta

19

El problema es, probablemente, que no ha reanudado desde el primer error. No puede lanzar un error desde un controlador de errores. Usted debe agregar en una declaración hoja de vida, algo así como lo siguiente, por lo que VBA ya no piensa que estás dentro del gestor 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 
3

¿Qué tal:

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

¿No hay 'objetos de lista' que no son tablas de consulta? Necesito la hoja para tener una tabla de consulta. –

+0

@Justin, de ser así, agregue una prueba para 'ListObjects (1) .QueryTable Is Nothing'; su código tampoco tenía esta prueba. El punto principal de mi muestra es verificar si la colección ListObjects tiene algún elemento antes de desreferenciar el primer elemento. – Joe

0

Este

On Error GoTo NextSheet: 

debe ser:

On Error GoTo NextSheet 

La otra solución es buena también.

1

Yo que puedo ayudarlo, tengo la siguiente función en mi "biblioteca". Como es una mezcla de funciones que escribí y funciones que encontré en la red, no estoy muy seguro de dónde viene esa.

Function GetTabList(Optional NameSpec As String = "*", _ 
       Optional wkb As Workbook = Nothing) As Variant 
    ' Returns an array of tabnames that match NameSpec 
    ' If no matching tabs are found, it returns False 

     Dim TabArray() As Variant 
     Dim t As Worksheet 
     Dim i As Integer 

     On Error GoTo NoFilesFound 
     If wkb Is Nothing Then Set wkb = ActiveWorkbook 
     ReDim TabArray(1 To wkb.Worksheets.Count) 
     i = 0 
     ' Loop until no more matching tabs are found 
     For Each t In wkb.Worksheets 
      If UCase(t.Name) Like UCase(NameSpec) Then 
       i = i + 1 
       TabArray(i) = t.Name 
      End If 
     Next t 
     ReDim Preserve TabArray(1 To i) 
     GetTabList = TabArray 
     Exit Function 

     ' Error handler 
    NoFilesFound: 
     GetTabList = False 
    End Function 
10

Como una manera general, para manejar el error en un circuito como el código de ejemplo, prefiero utilizar:

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

¿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 
0

podía comprender la respuesta del Gabin Smith necesita ser cambiado un poco para trabajar, ya que se puede' t reanudar 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 
0

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 manejador 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 
1

no quiero que a las embarcaciones de controladores de errores especiales para cada estructura de bucle en mi código, así que tengo una manera de encontrar un problema bucles que utilicen mi gestor de errores estándar, de modo que pueda luego escribe un controlador de error especial para ellos.

Si se produce un error en un ciclo, normalmente quiero saber qué fue lo que causó el error en lugar de omitirlo. Para conocer 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 ciclo, ya que el error se puede desencadenar cada vez que se repite el ciclo y en mi caso 80 000 iteraciones no es infrecuente.Por lo tanto, he puesto un 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 error estándar que se utiliza en cada procedimiento tiene este aspecto. Registra el tipo de error, el procedimiento en el que se produjo el error y los parámetros del procedimiento recibido (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 retener los valores previos de los datos de error y compararlos con las versiones actuales. Se registra el primer error, luego el segundo error idéntico empuja a la aplicación al modo de depuración si soy el usuario o si en otro modo de usuario, abandona 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 error tiene que ser la función más a prueba de balas en su aplicación ya que la aplicación no puede controlar correctamente errores en el registrador de error. Por esta razón, utilizo NZ() para asegurarme de que los nulos no puedan entrar sigilosamente. Tenga en cuenta que también agrego [loop] al segundo error idéntico, de modo que sé que primero busco los bucles en el procedimiento de error.

Cuestiones relacionadas