web-dev-qa-db-ja.com

ループ内のvbaエラー処理

「on error goto」を試みるvbaの新機能ですが、「index out of range」というエラーが引き続き発生します。

クエリテーブルを含むワークシートの名前が入力されたコンボボックスを作りたいだけです。

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

NextSheet:
    Next oSheet

問題がループ内でのOn Error GoToのネストに関連するのか、ループの使用を避ける方法に関連するのかはわかりません。

vbaerror-handling
18
justin cress

問題は、おそらく最初のエラーから再開していないことです。エラーハンドラー内からエラーをスローすることはできません。 VBAは、次のような再開ステートメントを追加する必要があります。これにより、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
23
Gavin Smith

サンプルコードのようなループでエラーを処理する一般的な方法として、次のように使用します。

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

どうですか：

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

コード内のすべてのループ構造に特別なエラーハンドラーを作成したくないので、標準のエラーハンドラーを使用して問題のループを見つけて、それらのループに特別なエラーハンドラーを作成できるようにします。

ループでエラーが発生した場合、通常、エラーをスキップするのではなく、エラーの原因を知りたいです。これらのエラーを見つけるために、多くの人が行うように、エラーメッセージをログファイルに書き込みます。ただし、ループでエラーが発生する場合、ループが繰り返されるたびにエラーがトリガーされる可能性があるため、ログファイルへの書き込みは危険です。私の場合、80 000回の繰り返しは珍しくありません。したがって、同一のエラーを検出し、エラーログへの書き込みをスキップするコードをエラーログ機能に追加しました。

すべての手順で使用される私の標準エラーハンドラは次のようになります。エラータイプ、エラーが発生したプロシージャ、およびプロシージャが受け取ったパラメータ（この場合はFileType）を記録します。

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

テーブルに書き込むエラーログ機能（私はms-accessにいます）は次のとおりです。静的変数を使用して、エラーデータの以前の値を保持し、現在のバージョンと比較します。最初のエラーがログに記録され、次に2番目の同一のエラーにより、ユーザーがアプリケーションである場合、または他のユーザーモードでアプリケーションを終了した場合、アプリケーションがデバッグモードになります。

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

アプリケーションはエラーロガー内のエラーを適切に処理できないため、エラーロガーはアプリケーションで最も強力な機能である必要があります。このため、NZ（）を使用して、nullが潜入できないようにします。2番目の同一エラーにも[loop]を追加し、最初にエラープロシージャのループを確認できるようにします。

1
AndrewM

この

On Error GoTo NextSheet:

する必要があります：

On Error GoTo NextSheet

他のソリューションも良いです。

0
Jon49

どう？

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

ループに適したエラー処理を制御する別の方法があります。 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
0
AndrewM

実際、Gavin Smithの答えは、動作するように少し変更する必要があります。エラーなしでは再開できないためです。

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
Makah