以为我会用几篇文章给我些回馈。 本文是一些添加错误处理的代码。 有空的时候，我想写有关多语言数据库和访问安全性的文章，但我将从简短的内容开始
该代码是用Access 2003编写的，但在Access 2000中应该有效
默认情况下，当您以表单，报表或全局模块形式启动新模块时，Access不会声明Option Explicit。 这意味着变量名中的一个简单的拼写错误可能会对代码造成严重破坏，并且在编译时不会捡起它。 所有模块都应具有显式选项，并且应显式声明所有变量。 您可以通过打开模块来强制所有新模块上的Option Explicit，然后在VBA窗口中转到“工具” /“选项” /“编辑器”选项卡，然后勾选“需要变量声明”。 这会将Option Explicit应用于所有新模块。
当您开始一个新过程时，没有添加错误处理，您必须自己做。 这是缓慢，乏味且重复的，恰恰是计算机应该执行的任务。
我在下面写的是三个过程，旨在从立即窗口中运行这些过程，这些过程将为每部分代码添加错误处理，并为每个模块添加显式选项。
除非有特殊情况，否则我现在不再编写错误处理。 我只是整天编写代码，并在一天结束时运行此例程以添加所有错误处理。
第一个重要说明。 这些过程必须在它们自己的模块中，我将其命名为basManualFunctions，然后将“ basManualFunctions”硬编码（如下所示）作为要排除的一个模块。 您无法编辑已打开并正在运行代码的模块。
随意使用这些程序（后果自负），修改，复制甚至出售（如果需要）。 感谢Lytton Consultants Ltd，但不是必须的。 我感谢Litwin和Getz，我从他的书中获得了大部分Access创意。
哦，是的，请先备份后再运行。
第一个过程是SetAllErrorChecking。
这是相当基本的，它遍历所有模块并为每个模块调用processmod。
然后，它将遍历所有表单和报表，并对它们所包含的每个模块执行相同的操作。
请注意，这些过程本身都没有错误检查。 那是有意的，它们是要亲自运行的，如果发生错误，我想手动调试代码。
Sub SetAllErrorChecking()
'This opens all code and sets error checking
Dim cont As Container
Dim mdl As Module
Dim doc As Document
Set cont = DBEngine(0)(0).Containers("Modules")
For Each doc In cont.Documents
If doc.Name <> "basManualFunctions" Then
DoCmd.OpenModule doc.Name
' Return reference to Module object.
Set mdl = Modules(doc.Name)
processmod mdl
DoCmd.Close acModule, doc.Name, acSaveYes
End If
Next doc
Dim i As Integer, j As Integer
Dim db As Database
Dim frm As Form, rpt As Report
Set db = CurrentDb
For i = 0 To db.Containers.Count - 1
If db.Containers(i).Name = "Forms" Then
For j = 0 To db.Containers(i).Documents.Count - 1
DoCmd.OpenForm db.Containers(i).Documents(j).Name, acDesign
Set frm = Forms(db.Containers(i).Documents(j).Name)
processmod frm.Module
DoCmd.Close acForm, db.Containers(i).Documents(j).Name, acSaveYes
' DoCmd.Close acForm, db.Containers(i).Documents(j).Name, acSaveNo
Next
End If
If db.Containers(i).Name = "Reports" Then
For j = 0 To db.Containers(i).Documents.Count - 1
DoCmd.OpenReport db.Containers(i).Documents(j).Name, acDesign
Set rpt = Reports(db.Containers(i).Documents(j).Name)
processmod rpt.Module
DoCmd.Close acReport, db.Containers(i).Documents(j).Name, acSaveYes
Next
End If
Next
Set db = Nothing
Set mdl = Nothing
Set doc = Nothing
Set cont = Nothing
End Sub 首先，我打印模块名称，然后假定未设置显式选项。 我扫描直到CountOfDeclarationLines的所有行，以寻找明确的选项。 如果找到它，请将boolGot设置为true。
如果找不到，请在模块中插入Option Explicit作为第二行。
现在，我开始寻找每个过程。 我不能使用模块函数，因为它们允许过程在实际的Private Sub或Public Function语句之前以注释行开始。
我扫描每个可能的过程起始行，找到后，调用processProc，传递过程名称，类型，起始行
这是processmod的代码
Sub processmod(mdl As Module)
Dim intLine As Long, strLine As String, strProcName As String, intBrac As Integer
Dim boolGot As Boolean
Debug.Print mdl.Name
boolGot = False
For intLine = 1 To mdl.CountOfDeclarationLines
strLine = mdl.Lines(intLine, 1)
If Trim(strLine) = "Option Explicit" Then boolGot = True
Next
If Not boolGot Then
mdl.InsertLines 2, "Option Explicit"
Debug.Print " Added Option Explicit"
End If
intLine = 0
While intLine < mdl.CountOfLines - 1
intLine = intLine + 1
strLine = mdl.Lines(intLine, 1)
If Left(strLine, 3) = "Sub" Then
'We have a new Sub Routing
strProcName = Right(strLine, Len(strLine) - 4)
intBrac = InStr(strProcName, "(")
strProcName = Left(strProcName, intBrac - 1)
processProc strProcName, intLine, "Sub", mdl
End If
If Left(strLine, 10) = "Public Sub" Then
'We have a new Sub Routing
strProcName = Right(strLine, Len(strLine) - 11)
intBrac = InStr(strProcName, "(")
strProcName = Left(strProcName, intBrac - 1)
processProc strProcName, intLine, "Sub", mdl
End If
If Left(strLine, 11) = "Private Sub" Then
'We have a new Sub Routing
strProcName = Right(strLine, Len(strLine) - 12)
intBrac = InStr(strProcName, "(")
strProcName = Left(strProcName, intBrac - 1)
processProc strProcName, intLine, "Sub", mdl
End If
If Left(strLine, 8) = "Function" Then
'We have a new Function Routing
strProcName = Right(strLine, Len(strLine) - 9)
intBrac = InStr(strProcName, "(")
strProcName = Left(strProcName, intBrac - 1)
processProc strProcName, intLine, "Function", mdl
End If
If Left(strLine, 15) = "Public Function" Then
'We have a new Function Routing
strProcName = Right(strLine, Len(strLine) - 16)
intBrac = InStr(strProcName, "(")
strProcName = Left(strProcName, intBrac - 1)
processProc strProcName, intLine, "Function", mdl
End If
If Left(strLine, 16) = "Private Function" Then
'We have a new Function Routing
strProcName = Right(strLine, Len(strLine) - 17)
intBrac = InStr(strProcName, "(")
strProcName = Left(strProcName, intBrac - 1)
processProc strProcName, intLine, "Function", mdl
End If
Wend
End Sub ProcessProc假定您没有错误处理，并在模块中运行直到找到End Sub或End Function。
它扫描每一行，以查找错误。 如果它在过程中的任何位置都发现On Error，则假定您对此proc有错误处理，并且将其忽略。 因此，如果您不想在过程中进行错误处理，则可以添加注释行
'On Error这里没有错误处理
它将忽略该过程。
如果找不到错误处理，则添加以下内容
在开始行之后，我们添加
错误时转到xxx_Err，其中xxx是过程名称
在该过程的最后，我们添加了以下几行。 可以根据您自己的错误处理条件进行定制
xxx_退出：
退出子（或退出功能）
xxx_Err：
MsgBox错误说明和“输入xxx”
恢复xxx_Exit
最后打印出“添加的错误处理”，这样我就可以看到完成后添加了什么。
所以这是processproc
Sub processProc(ByVal strProcName As String, ByVal intStartLine As Long, ByVal strSubFunc As String, ByRef mdl As Module)
Dim intThisLine As Integer, boolGot As Boolean, intLastLine As Integer, strText As String
boolGot = False
intThisLine = intStartLine
While mdl.Lines(intThisLine, 1) <> "End " & strSubFunc
intThisLine = intThisLine + 1
If InStr(mdl.Lines(intThisLine, 1), "On Error") > 0 Then boolGot = True
Wend
intLastLine = intThisLine
If Not boolGot Then
Debug.Print " " & strProcName
strText = strProcName & "_Exit:" & vbCrLf
strText = strText & " Exit " & strSubFunc & vbCrLf
strText = strText & strProcName & "_Err:" & vbCrLf
strText = strText & " MsgBox Err.Description & " & Chr(34) & " in " & strProcName & Chr(34) & vbCrLf
strText = strText & " Resume " & strProcName & "_Exit"
mdl.InsertLines intLastLine, strText
mdl.InsertLines intStartLine + 1, "On Error Goto " & strProcName & "_Err"
Debug.Print " Added Error Handling"
End If
End Sub 马克·费舍尔
利顿顾问有限公司
From: https://bytes.com/topic/access/insights/667905-automatic-error-handling-access
扫一扫
被折叠的 条评论
为什么被折叠?
到【灌水乐园】发言
