访问VBA:是否可以重置错误处理

Question

我正在使用我的程序的第一部分

在错误上开始

假设在我的第二部分我再次使用

在错误恢复下

第二个错误陷阱将不会被激活,因为第一个错误陷阱仍将处于活动状态.有没有办法在使用后取消激活第一个错误处理程序？

Set objexcel = CreateObject("excel.Application")
                     objexcel.Visible = True
                     On Error GoTo Openwb
                     wbExists = False
                     Set wbexcel = objexcel.Workbooks.Open("C:\REPORT3.xls")
                     Set objSht = wbexcel.Worksheets("Sheet1")
                     objSht.Activate
                     wbExists = True
Openwb:

                     On Error GoTo 0
                     If Not wbExists Then
                     objexcel.Workbooks.Add
                     Set wbexcel = objexcel.ActiveWorkbook
                     Set objSht = wbexcel.Worksheets("Sheet1")

                     End If

                     On Error GoTo 0

Set db = DBEngine.opendatabase("C:\book.mdb")
Set rs = db.OpenRecordset("records")

Set rs2 = CreateObject("ADODB.Recordset")
rs2.ActiveConnection = CurrentProject.Connection


For Each tdf In CurrentDb.TableDefs

   If Left(tdf.Name, 4) <> "MSys" Then
        rs.MoveFirst
        strsql = "SELECT * From [" & tdf.Name & "] WHERE s=15 "

        Do While Not rs.EOF
            On Error Resume Next

            rs2.Open strsql 

在执行最后一个语句时,我想忽略该错误并转到下一个表,但错误处理似乎不起作用.

Answer 1

On error goto 0 为错误处理提供视觉基础(在一般消息框中)

On error goto label将代码重定向到标签:

On error resume next 将忽略该错误并继续

Resume next 引发错误后将代码重定向到下一行

它意味着指令的组合,如

On Error goto 0
...
On Error goto 0

没有意义

如果你想重定向"on error"指令,你必须这样做:

Do While Not rs.EOF

    On Error Resume Next
    rs2.Open strsql
    On error Goto 0

    rs2.moveNext

Loop

如果您想将错误重定向到标签(用于治疗或其他),然后返回发生错误的代码,您必须编写如下内容:

On error goto label
...
...
On error goto 0
exit sub (or function)

label:
....
resume next
end function

但我真的建议你对错误管理更加严格.你应该首先能够做到这样的事情:

Set objexcel = CreateObject("excel.Application")
objexcel.Visible = True

On Error GoTo error_Treatment
wbExists = False
Set wbexcel = objexcel.Workbooks.Open("C:\REPORT3.xls")
Set objSht = wbexcel.Worksheets("Sheet1")
objSht.Activate
wbExists = True
On error GoTo 0

Set db = DBEngine.opendatabase("C:\book.mdb")
Set rs = db.OpenRecordset("records")

Set rs2 = CreateObject("ADODB.Recordset")
rs2.ActiveConnection = CurrentProject.Connection

For Each tdf In CurrentDb.TableDefs
    ....
    'there are a number of potential errors here in your code'
    'you should make sure that rs2 is closed before reopening it with a new instruction'
    'etc.'
Next tdf

Exit sub

error_treatment:
SELECT Case err.number
   Case **** '(the err.number raised when the file is not found)'
       objexcel.Workbooks.Add
       Set wbexcel = objexcel.ActiveWorkbook
       Set objSht = wbexcel.Worksheets("Sheet1")
       Resume next 'go back to the code'
   Case **** '(the recordset cannot be opened)'
       ....
       ....
       Resume next 'go back to the code'
   Case **** '(whatever other error to treat)'
       ....
       ....
       Resume next 'go back to the code'
   Case Else
       debug.print err.number, err.description '(check if .description is a property of the error object)'
       'your error will be displayed in the immediate windows of VBA.' 
       'You can understand it and correct your code until it runs'
End select
End sub

下一步是预测代码中的错误,以便不会引发错误的对象.例如,您可以编写如下通用函数:

Public function fileExists (myFileName) as Boolean

然后,您可以通过测试xls文件的存在来利用代码中的此功能:

if fileExists("C:\REPORT3.xls") Then
    Set wbexcel = objexcel.Workbooks.Open("C:\REPORT3.xls")
Else
   objexcel.Workbooks.Add
   Set wbexcel = objexcel.ActiveWorkbook
Endif        
Set objSht = wbexcel.Worksheets("Sheet1")
objSht.Activate

你不再需要你的wbExist变量了......

同样,您应该预测记录集没有记录的情况.在测试之前写下rs.MoveFirst可能会引发错误.你应该写

If rs.EOF and rs.BOF then
Else
    rs.moveFirst
    Do while not rs.EOF
         rs.moveNext
    Loop
Endif

Answer 2

您需要清除错误。尝试将此代码放入：

If Err.Number > 0 Then
    Err.Clear
End If

您还可以使用 Err.Number 来处理特定的错误情况。

Answer 3

避免错误而不是处理错误几乎总是更好的选择。例如：

Set objexcel = CreateObject("excel.Application")
objexcel.Visible = True

'On Error GoTo Openwb '
'wbExists = False '

If Dir("C:\REPORT3.xls") = "" Then
    objexcel.Workbooks.Add
    Set wbexcel = objexcel.ActiveWorkbook
    Set objSht = wbexcel.Worksheets("Sheet1")
Else
    Set wbexcel = objexcel.Workbooks.Open("C:\REPORT3.xls")
    Set objSht = wbexcel.Worksheets("Sheet1")
End If

objSht.Activate
'wbExists = True '