0

私はこのようなクエリを実行しています

select field from table;

そのクエリでは、多くのテーブルでループが実行されています。したがって、フィールドがテーブルに存在しない場合は、

ランタイムエラー3061

このエラーフローのエラーを別のポイントに移動する必要があるなど、このエラーをバイパスするにはどうすればよいですか?

これは私がこのフォーラムを通過した後に最近持っているコードです。

Option Explicit

Private Sub UpdateNulls()
 Dim rs2 As DAO.Recordset
  Dim tdf As DAO.TableDef
  Dim db As Database
  Dim varii As Variant, strField As String
  Dim strsql As String, strsql2 As String, strsql3 As String
  Dim astrFields As Variant
  Dim intIx As Integer
  Dim field As Variant
  Dim astrvalidcodes As Variant
  Dim found As Boolean
  Dim v As Variant


  Open "C:\Documents and Settings\Desktop\testfile.txt" For Input As #1
  varii = ""
  Do While Not EOF(1)
    Line Input #1, strField
    varii = varii & "," & strField
  Loop
  Close #1
  astrFields = Split(varii, ",")  'Element 0 empty




        For intIx = 1 To UBound(astrFields)


        'Function ListFieldDescriptions()
                            Dim cn As New ADODB.Connection, cn2 As New ADODB.Connection
                            Dim rs As ADODB.Recordset, rs3 As ADODB.Recordset
                            Dim connString As String
                            Dim SelectFieldName

                            Set cn = CurrentProject.Connection

                            SelectFieldName = astrFields(intIx)

                            Set rs = cn.OpenSchema(adSchemaColumns, Array(Empty, Empty, Empty, SelectFieldName))

                           'Show the tables that have been selected '
                            While Not rs.EOF

                           'Exclude MS system tables '
                            If Left(rs!Table_Name, 4) <> "MSys" Then
                            strsql = "Select t.* From [" & rs!Table_Name & "] t Inner Join 01UMWELT On t.fall = [01UMWELT].fall Where [01UMWELT].Status = 4"
                            End If

                            Set rs3 = CurrentDb.OpenRecordset(strsql)

            'End Function

            strsql2 = "SELECT label.validcode FROM variablen s INNER JOIN label ON s.id=label.variablenid WHERE varname='" & astrFields(intIx) & "'"

            Set db = OpenDatabase("C:\Documents and Settings\Desktop\Codebook.mdb")
            Set rs2 = db.OpenRecordset(strsql2)

                With rs2
                .MoveLast
                .MoveFirst
                 astrvalidcodes = rs2.GetRows(.RecordCount)
                .Close '
                End With


                    With rs3
                    .MoveFirst
                    While Not rs3.EOF
                        found = False
                        For Each v In astrvalidcodes
                        If v = .Fields(0) Then
                        found = True
                        Debug.Print .Fields(0)
                        Debug.Print .Fields(1)


              Exit For
                    End If
                    Next
                If Not found Then
                msgbox "xxxxxxxxxxxxxxxx"

                End If
                End If
                .MoveNext


                Wend
                End With

           On Error GoTo 0        'End of special handling

    Wend



Next intIx


  End Sub

私は

タイプの不一致ランタイムエラー

Set rs3 = CurrentDb.OpenRecordset(strsql)

私は混乱していると思いadoますdaoが、それがどこにあるのかは確かではありません。

4

3 に答える 3

4

On ErrorVBA が提供するステートメントを使用します。

Sub TableTest
  On Error Goto TableTest_Error

  ' ...code that can fail... '

  Exit Sub

:TableTest_Error
  If Err.Number = 3061 Then
    Err.Clear()
    DoSomething()
  Else
    MsgBox Err.Description ' or whatever you find appropriate '
  End If
End Sub

または、行単位で自動エラー処理 (実行の中断やエラー メッセージの表示など) をオフにすることもできます。

Sub TableTest
  ' ... fail-safe code ... '

  On Error Resume Next
  ' ...code that can fail... '
  If Err.Number = 3061 Then
    Err.Clear()
    DoSomething()
  Else
    MsgBox Err.Description
  End If
  On Error Goto 0

  ' ...mode fail-safe code... '
End Sub

次のステートメントを使用できます。

  • On Error Resume NextVBA 統合エラー処理 (メッセージ ボックスなど) を完全にオフにすると、次の行から実行が再開されます。ぶら下がっているエラーは通常の実行フローを混乱させる可能性があるため、使用後は非常に早い段階でエラーを確認してください。それを防ぐために、エラーをキャッチしたらすぐにクリアしてください。
  • On Error Goto <Jump Label>特定のラベルで実行を再開します。主に、あらゆる種類のエラーをキャッチする関数ごとのエラー ハンドラーに使用されます。
  • On Error Goto <Line Number>指定された行番号で再開します。それから離れてください、それは役に立たず、危険ですらありません.
  • On Error Goto 0近親です。VBA 統合エラー管理 (メッセージ ボックスなど) を元に戻します。

編集

編集された質問から、これはあなたの問題を解決するための私の提案です。

For Each FieldName In FieldNames ' assuming you have some looping construct here '

  strsql3 = "SELECT " & FieldName & " FROM table"

  On Error Resume Next
  Set rs3 = CurrentDb.OpenRecordset(strsql3)

  If Err.Number = 3061 Then
    ' Do nothing. We dont care about this error '
    Err.Clear
  Else
    MsgBox "Uncaught error number " & Err.Number & " (" & Err.Description & ")"
    Err.Clear
  End If

  On Error GoTo 0

Next FieldName

同じ Sub または Function でループを続行する前に必ずエラーをクリアしてください。前述したように、ダングリング エラーによってコード フローが予期せぬものになります。

于 2008-11-10T08:38:47.477 に答える
3

エラーをトラップするのではなく、TableDefs を使用してフィールドをチェックしたり、ADO と DAO を組み合わせて使用​​したりしないでください。ADO スキーマは、必須フィールドを含むテーブルのリストを提供できます。

Function ListTablesContainingField()
Dim cn As New ADODB.Connection, cn2 As New ADODB.Connection
Dim rs As ADODB.Recordset, rs2 As ADODB.Recordset
Dim connString As String
Dim SelectFieldName

    Set cn = CurrentProject.Connection

    SelectFieldName = "Fall" 'For tksy '

    'Get names of all tables that have a column called 'ID' '
    Set rs = cn.OpenSchema(adSchemaColumns, _
    Array(Empty, Empty, Empty, SelectFieldName))

    'Show the tables that have been selected '
    While Not rs.EOF

        'Exclude MS system tables '
        If Left(rs!Table_Name, 4) <> "MSys" Then
            ' Edit for tksy, who is using more than one forum '
            If tdf.Name = "01UMWELT" Then
                strSQL = "Select * From 01UMWELT Where Status = 5"
            Else
                strSQL = "Select a.* From [" & rs!Table_Name _
                & "] a Inner Join 01UMWELT On a.fall = 01UMWELT.fall " _
                & "Where 01UMWELT.Status = 5"
            End If
            Set rs2 = CurrentDb.OpenRecordset(strSQL)

            Do While Not rs2.EOF
                For i = 0 To rs2.Fields.Count - 1
                    If IsNull(rs2.Fields(i)) Then
                        rs2.Edit
                        rs2.Fields(i) = 111111
                        rs2.Update
                    End If
                Next
                rs2.MoveNext
             Loop
        End If
        rs.MoveNext
    Wend
    rs.Close
    Set cn = Nothing

End Function
于 2008-11-10T11:00:48.687 に答える
0

これを試して:

On Error Resume Next ' エラーが発生した場合は、次のステートメントに移動します。

...選択を試行するステートメント...

If (Err <> 0) その後

...act on error, or simply ignore if necessary...

終了条件

On Error Goto 0 ' エラー処理を前の状態にリセットします。

于 2008-11-10T08:37:23.720 に答える