लूप में vba त्रुटि हैंडलिंग

Question

vba पर नया, 'त्रुटि गोटो' पर कोशिश कर रहा है, लेकिन, मुझे त्रुटियों की अनुक्रमणिका 'सीमा से बाहर' मिल रही है।

मैं सिर्फ एक कॉम्बो बॉक्स बनाना चाहता हूं जो वर्कशीट के नाम से आबादी वाला है जिसमें क्वेरीटेबल होता है।

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

NextSheet: 
    Next oSheet 

मुझे यकीन है कि समस्या एक पाश, या कैसे अंदर पर त्रुटि गोटो घोंसला बनाने से पाश का उपयोग कर से बचने के लिए से संबंधित है कि क्या नहीं कर रहा हूँ।

Answer 1

समस्या शायद है कि आप पहले त्रुटि से फिर से शुरू नहीं किया है। आप एक त्रुटि हैंडलर से एक त्रुटि फेंक नहीं सकते हैं। आप निम्नलिखित की तरह कुछ एक को फिर से शुरू बयान में जोड़ना चाहिए, है, तो VBA नहीं रह गया है सोचता है कि आप त्रुटि हैंडलर के अंदर कर रहे हैं:

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

कैसे के बारे में:

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

Answer 3

यह

On Error GoTo NextSheet: 

होना चाहिए:

On Error GoTo NextSheet 

अन्य समाधान भी अच्छा है।

Answer 4

मैं आपकी मदद कर सकता हूं, मेरे पास मेरी "लाइब्रेरी" में निम्न कार्य है। चूंकि यह नेट पर मिले कार्यों और कार्यों के मिश्रण का मिश्रण है, इसलिए मुझे पूरा यकीन नहीं है कि वह कहां से आता है।

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

एक सामान्य तरीके से अपने नमूना कोड की तरह एक पाश में त्रुटि को संभालने के लिए के रूप में, मैं नहीं बल्कि प्रयोग करेंगे:

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

Answer 6

के बारे में क्या?

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

या

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

वास्तव Gabin स्मिथ के जवाब काम करने के लिए एक सा को बदलने की आवश्यकता है, क्योंकि आप कर सकते हैं ' बिना किसी त्रुटि के फिर से शुरू करें।

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

त्रुटियों के लिए अच्छी तरह से काम करने वाली त्रुटि प्रबंधन को नियंत्रित करने का एक और तरीका है। एक स्ट्रिंग वैरिएबल बनाएं जिसे here कहा जाता है और यह निर्धारित करने के लिए चर का उपयोग करें कि एक त्रुटि हैडलर त्रुटि को कैसे संभालता है।

कोड टेम्पलेट है:

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

मैं नहीं चाहता कि मेरी कोड में हर पाश संरचना के लिए विशेष त्रुटि संचालकों शिल्प के लिए तो मैं समस्या को खोजने का एक तरीका है मेरे मानक त्रुटि हैंडलर का उपयोग कर छोरों चाहते हैं, ताकि मैं यह कर सकते हैं फिर उनके लिए एक विशेष त्रुटि हैंडलर लिखें।

यदि लूप में कोई त्रुटि उत्पन्न होती है, तो मैं सामान्य रूप से जानना चाहता हूं कि इसके कारण केवल त्रुटि को छोड़ने के बजाय त्रुटि क्या हुई। इन त्रुटियों के बारे में जानने के लिए, मैं एक लॉग फ़ाइल में त्रुटि संदेश लिखता हूं जितना लोग करते हैं। हालांकि लॉग फ़ाइल में लिखना खतरनाक है यदि लूप में कोई त्रुटि होती है क्योंकि लूप पुनरावृत्त होने पर हर बार त्रुटि ट्रिगर की जा सकती है और मेरे मामले में 80 000 पुनरावृत्तियों असामान्य नहीं है।इसलिए मैंने अपने त्रुटि लॉगिंग फ़ंक्शन में कुछ कोड डाला है जो समान त्रुटियों का पता लगाता है और त्रुटि लॉग में उन्हें लिखता है।

प्रत्येक प्रक्रिया पर उपयोग किया जाने वाला मेरा मानक त्रुटि हैंडलर इस तरह दिखता है। यह त्रुटि प्रकार, त्रुटि में हुई प्रक्रिया और प्रक्रिया प्राप्त करने वाले किसी भी पैरामीटर को रिकॉर्ड करता है (इस मामले में फ़ाइल टाइप)।

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

मेरी त्रुटि लॉगिंग फ़ंक्शन जो तालिका में लिखता है (मैं एमएस-एक्सेस में हूं) निम्नानुसार है। यह त्रुटि डेटा के पिछले मानों को बनाए रखने के लिए स्थिर चर का उपयोग करता है और उन्हें मौजूदा संस्करणों से तुलना करता है। पहली त्रुटि लॉग है, तो दूसरी समान त्रुटि एप्लिकेशन को डीबग मोड में धक्का देती है यदि मैं उपयोगकर्ता हूं या अन्य उपयोगकर्ता मोड में, एप्लिकेशन छोड़ देता है।

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 

नोट एक त्रुटि लकड़हारा है कि आवेदन शान से त्रुटि लकड़हारा में त्रुटियों को संभाल नहीं कर सकते हैं के रूप में अपने आवेदन में सबसे बुलेट प्रूफ समारोह होने के लिए। इस कारण से, मैं यह सुनिश्चित करने के लिए एनजेड() का उपयोग करता हूं कि नल इन्हें घुसपैठ नहीं कर सकता है। ध्यान दें कि मैं दूसरी समान त्रुटि में [लूप] भी जोड़ता हूं ताकि मैं पहले त्रुटि प्रक्रिया में लूप को देख सकूं।