Vba hatası döngüde işleniyor

Question

Yeni bir "açık hata goto'sunu" denemek, ancak hataların 'dizinin dışına çıkmamasına' devam ediyorum.

Sadece bir sorgulanabilir içeren çalışma sayfalarının adları tarafından doldurulmuş bir açılan kutu yapmak istiyorum.

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

NextSheet: 
    Next oSheet 

Sorun döngü kullanarak önlemek için bir döngü veya nasıl içeride On Error GoTo iç içe ilgili olup olmadığını emin değilim.

Answer 1

sorun ilk hatadan başlamazsa o muhtemelen. Hata işleyicisinden bir hata atamazsınız. Gabin Smith'in cevabı bulmak için biraz değiştirilmesi gerekir

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

nereden:

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

Answer 3

Bu

On Error GoTo NextSheet: 

olmalı:

On Error GoTo NextSheet 

diğer çözüm de iyidir.

Answer 4

Size yardımcı olabilirim, "kütüphanemde" aşağıdaki işlev var. Yazdığım işlevler ve ağda bulduğum işlevler karışımı olduğundan, bunun nereden geldiğinden emin değilim.

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

sizin örnek kodu gibi bir döngü içinde hatayı işlemek için genel bir yol olarak, ben daha çok kullanırsınız:

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

Answer 6

ne olacak?

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

Ya

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

Gerçek baskı 'nedeniyle yapabilirsiniz: VBA artık hata işleyicisi içinde olduğunu düşünüyor, böylece aşağıdaki gibi, bir özgeçmiş açıklamada şey eklemek gerekir Bir hata olmadan devam edersiniz.

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

Döngüler için iyi çalışan hata işlemenin başka bir yolu vardır. here adlı bir dize değişkeni oluşturun ve tek bir hata işleyicisinin hatayı nasıl işlediğini belirlemek için değişkeni kullanın.

kod şablonu:

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

benim standart hata işleyicisi kullanarak döngüler yüzden sorunu bulmak için bir yol var benim kodunda her döngü yapısı için özel hata işleyicileri zanaat istemiyorum elimden böylece daha sonra onlar için özel bir hata işleyici yazınız.

Bir döngüde bir hata oluşursa, normalde hatadan neyin neden geçtiğini bilmek istiyorum. Bu hataları öğrenmek için, birçok insanın yaptığı gibi bir günlük dosyasına hata mesajları yazarım. Ancak, bir döngüde hata oluşursa, döngü yinelendiğinde ve 80 000 yinelemede yaygın olmayan bir hata olduğunda, bir günlük dosyasına yazma tehlikelidir.Bu nedenle, aynı hataları algılayan ve bunları hata günlüğüne yazmayı atlayan hata kayıt fonksiyonuma bazı kodlar koydum.

Her yordamda kullanılan standart hata işleyicim buna benzer. Hata türünü kaydeder, meydana gelen hatayı ve alınan prosedürün herhangi bir parametresini (bu durumda FileType) kaydeder.

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

Tabloya yazdığım (ms-giriş halindeyim) hata günlükleme işlevim aşağıdaki gibidir. Önceki hata değerlerini korumak ve mevcut sürümlerle karşılaştırmak için statik değişkenler kullanır. İlk hata günlüğe kaydedilir, daha sonra ikinci özdeş hata, kullanıcı olduğumda veya diğer kullanıcı modunda ise uygulamayı sonlandırırsa hata ayıklama moduna iter. Bir hata logger olduğunu

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 

Not incelikle hata logları hataları işleyemez uygulama olarak uygulamanızda en mermi geçirmez fonksiyonu olmak. Bu nedenle, null'ların gizlice giremediğinden emin olmak için NZ() kullanıyorum. Ayrıca, hata işlemindeki döngülere bakmayı bildiğimden, ikinci özdeş hataya [döngü] eklediğimi unutmayın.