2008-11-10 5 views
0

Я выполнение запроса, как этотMS Access: Как обходить/подавлять ошибку?

select field from table; 

В этом запросе, имеется петля работает на многих столах. Таким образом, если поле не присутствует в таблице я получаю

Runtime Ошибка 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, но я, безусловно, не конечно, где это.

+0

Прежде всего: прекратите использование GoTo. Немедленно. Это плохо. Я имею в виду действительно * зло *, как в «Ящике Пандоры». Единственное место GoTo, действительное в коде VB, находится в операциях «On Error Goto». – Tomalak 2008-11-10 12:58:43

+0

Второе: измените его, чтобы использовать стиль «Принудительное возобновление следующего», здесь это гораздо более уместно. Вы дважды отметили, что 3061 - это фактическое число ошибок? Используйте отладчик для выполнения кода. – Tomalak 2008-11-10 13:16:31

+0

Я неохотно закодировал goto, но я удалил его Я попробовал отладку, но все та же ошибка 3061 – tksy 2008-11-10 13:25:02

ответ

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 
0

Попробуйте это:

On Error Resume Next 'Если произошла ошибка, переходим к следующему утверждению.

... утверждение, что пробует выбрать ...

Если (Err <> 0) Тогда

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

End If

On Error Goto 0 'Сброс обработки ошибок в предыдущей государство.

4

Используйте On Error о том, что VBA поставки:

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 Next полностью отключает встроенную обработку ошибок VBA (окно сообщения и т. Д.), Выполнение просто возобновляется на следующей строке. Не забудьте проверить ошибку очень рано, после того, как вы ее использовали, поскольку оборванная ошибка может нарушить нормальный поток выполнения. Устраните ошибку, как только вы ее поймаете, чтобы это предотвратить.
  • On Error Goto <Jump Label> возобновляет выполнение на данной метке, в основном используется для обработчиков ошибок для каждой функции, которые улавливают всевозможные ошибки.
  • On Error Goto <Line Number> возобновляется с заданным номером строки. Держитесь подальше от этого, это не полезно, даже опасно.
  • On Error Goto 0 это близко двоюродный брат.Восстанавливает VBA интегрированное управление ошибками (окно сообщения и т.д.)

EDIT

С отредактированного qestion, это мое предложение, чтобы решить вашу проблему.

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 

Убедитесь, чтобы устранить ошибку в любом случае, прежде чем идти с петлей в одной и той же подпрограммы или функции. Как я уже сказал, оборванная ошибка приводит к тому, что поток кода становится неожиданным!