Gestione errori vba in loop

Question

Nuovo in vba, tentando un errore 'goto' ma, continuo a ricevere l'errore 'indice fuori intervallo'.

Voglio solo creare una casella combinata popolata dai nomi dei fogli di lavoro che contengono una querytable.

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

NextSheet: 
    Next oSheet 

non sono sicuro se il problema è legato alla nidificazione l'On Error GoTo all'interno di un ciclo, o il modo di evitare di utilizzare il ciclo.

Answer 1

Il problema è probabilmente che non hai ripreso dal primo errore. Non puoi generare un errore da un gestore di errori. Si dovrebbe aggiungere in un comunicato curriculum, qualcosa di simile a quanto segue, in modo da VBA non pensa che tu sia all'interno del gestore di errore:

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 2

ne dite:

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

Answer 3

Questo

On Error GoTo NextSheet: 

dovrebbe essere:

On Error GoTo NextSheet 

L'altra soluzione è troppo buono.

Answer 4

Io che posso aiutarti, ho la seguente funzione nella mia "libreria". Dal momento che è un mix di funzioni che ho scritto e funzioni che ho trovato in rete, non sono molto sicuro da dove provenga.

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 

Answer 5

Come un modo generale, per gestire l'errore in un ciclo come il vostro codice di esempio, avrei preferito usare:

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

Answer 6

Che dire?

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 7

actualy risposta del Gabin Smith ha bisogno di essere cambiato un po 'a lavorare, perché si puo' riprendere senza un errore.

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 8

C'è un altro modo di controllare la gestione degli errori che funziona bene per i cicli. Creare una variabile stringa denominata here e utilizzare la variabile per determinare come un singolo gestore di errori gestisce l'errore.

Il modello di codice è:

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 9

non voglio alle imbarcazioni gestori di errori speciali per ogni struttura ad anello nel mio codice quindi ho un modo di trovare problema loop usando il mio gestore degli errori standard in modo che posso quindi scrivi un gestore di errori speciale per loro.

Se si verifica un errore in un ciclo, in genere desidero sapere cosa ha causato l'errore anziché saltarlo. Per scoprire questi errori, scrivo i messaggi di errore in un file di registro come fanno molte persone. Tuttavia scrivere in un file di log è pericoloso se si verifica un errore in un loop poiché l'errore può essere attivato per ogni volta che il ciclo itera e nel mio caso 80.000 iterazioni non sono infrequenti.Ho quindi inserito del codice nella mia funzione di registrazione degli errori che rileva errori identici e salta scrivendoli nel log degli errori.

Il mio gestore di errori standard utilizzato in ogni procedura è simile a questo. Registra il tipo di errore, la procedura in cui si è verificato l'errore e tutti i parametri ricevuti dalla procedura (FileType in questo caso).

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

mio errore funzione di registrazione, che scrive a un tavolo (io sono in MS-Access) è la seguente. Utilizza le variabili statiche per conservare i valori precedenti dei dati di errore e confrontarli con le versioni correnti. Viene registrato il primo errore, quindi il secondo errore identico spinge l'applicazione in modalità di debug se sono l'utente o se in un'altra modalità utente, esce dall'applicazione.

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 

Nota che un logger di errore deve essere il più funzione di prova di proiettile nella vostra applicazione, come l'applicazione non in grado di gestire con garbo errori nel logger errore. Per questo motivo, io uso NZ() per assicurarmi che i nulli non possano entrare di nascosto. Nota che aggiungo anche [loop] al secondo errore identico in modo che sappia prima cercare i loop nella procedura di errore.