traitement des erreurs vba en boucle
Nouveau sur vba, j'essaie un 'on error on goto' mais je continue à avoir des erreurs 'index hors de portée'.
Je souhaite simplement créer une liste déroulante contenant les noms des feuilles de calcul contenant une table de requête.
For Each oSheet In ActiveWorkbook.Sheets
On Error GoTo NextSheet:
Set qry = oSheet.ListObjects(1).QueryTable
oCmbBox.AddItem oSheet.Name
NextSheet:
Next oSheet
Je ne sais pas si le problème est lié à l'imbrication de Go On sur l'erreur dans une boucle ou à la façon d'éviter d'utiliser la boucle.
Le problème est probablement que vous n'avez pas repris depuis la première erreur. Vous ne pouvez pas générer d'erreur dans un gestionnaire d'erreur. Vous devez ajouter dans une instruction de résumé, quelque chose comme ceci, afin que VBA ne pense plus que vous êtes à l'intérieur du gestionnaire d'erreurs:
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
Comme moyen général de gérer les erreurs dans une boucle comme votre exemple de code, je préférerais utiliser
on error resume next
for each...
'do something that might raise an error, then
if err.number <> 0 then
...
end if
next ....
Que diriez-vous:
For Each oSheet In ActiveWorkbook.Sheets
If oSheet.ListObjects.Count > 0 Then
oCmbBox.AddItem oSheet.Name
End If
Next oSheet
Je ne souhaite pas créer de gestionnaires d’erreur spéciaux pour chaque structure de boucle de mon code. Par conséquent, j’ai un moyen de rechercher les boucles qui posent des problèmes à l’aide de mon gestionnaire d’erreur standard afin de pouvoir ensuite écrire un gestionnaire d’erreur spécial pour elles.
Si une erreur se produit dans une boucle, je souhaite normalement connaître la cause de l'erreur plutôt que de simplement la sauter. Pour connaître ces erreurs, j'écris des messages d'erreur dans un fichier journal comme le font beaucoup de personnes. Cependant, l'écriture dans un fichier journal est dangereuse si une erreur se produit dans une boucle, car l'erreur peut être déclenchée à chaque fois que la boucle itère et dans mon cas, 80 000 itérations ne sont pas rares. J'ai donc mis du code dans ma fonction de journalisation des erreurs qui détecte les erreurs identiques et ignore leur écriture dans le journal des erreurs.
Mon gestionnaire d'erreur standard utilisé pour chaque procédure ressemble à ceci. Il enregistre le type d'erreur, la procédure dans laquelle l'erreur s'est produite et tous les paramètres de la procédure reçus (FileType dans ce cas).
procerr:
Call NewErrorLog(Err.number, Err.Description, "GetOutputFileType", FileType)
Resume exitproc
Ma fonction de journalisation des erreurs qui écrit dans une table (je suis dans ms-access) est la suivante. Il utilise des variables statiques pour conserver les valeurs précédentes des données d'erreur et les comparer aux versions actuelles. La première erreur est enregistrée, puis la deuxième erreur identique pousse l'application en mode débogage si je suis l'utilisateur ou si dans un autre mode utilisateur, quitte l'application.
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
Notez qu'un enregistreur d'erreurs doit être la fonction la plus fiable dans votre application, car celle-ci ne peut pas gérer correctement les erreurs dans l'enregistreur d'erreurs. Pour cette raison, j'utilise NZ () pour m'assurer que les valeurs NULL ne peuvent pas se faufiler. Notez que j'ajoute également [boucle] à la deuxième erreur identique afin que je sache qu'il faut d'abord examiner les boucles de la procédure d'erreur.
Ce
On Error GoTo NextSheet:
Devrait être:
On Error GoTo NextSheet
L'autre solution est bonne aussi.
Qu'en est-il de?
If oSheet.QueryTables.Count > 0 Then
oCmbBox.AddItem oSheet.Name
End If
Ou
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
Il existe un autre moyen de contrôler la gestion des erreurs qui fonctionne bien pour les boucles. Créez une variable de chaîne appelée here et utilisez-la pour déterminer comment un seul gestionnaire d'erreur gère l'erreur.
Le modèle de code est:
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
En réalité, la réponse de Gavin Smith doit être un peu modifiée pour fonctionner, car vous ne pouvez pas reprendre sans erreur.
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