我正在执行这样的查询
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
,但我不确定它在哪里。
答案 0 :(得分:4)
使用VBA提供的On Error
语句:
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集成错误管理(消息框等)修改强>
根据编辑过的问题,这是我提出的解决问题的建议。
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中的循环之前,请确保在任何情况下清除错误 。正如我所说,悬空错误导致代码流变得意外!
答案 1 :(得分:3)
为什么不使用TableDef检查字段或使用ADO和DAO的混合,而不是捕获错误? ADO Schemas可以提供包含必填字段的表列表:
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
答案 2 :(得分:0)
试试这个:
On Error Resume Next'如果发生错误,请转到下一个语句。
...尝试选择的语句...
如果(Err&lt;&gt; 0)那么
...act on error, or simply ignore if necessary...
结束如果
On Error Goto 0'将错误处理重置为先前状态。