分类： VBA

如果将来，计算机能自己编写代码了，那程序员就都失业了。

哈哈，开玩笑。这篇文章跟人工智能一点关系都没有。引入正题前，先讲一点题外话作为引子。

先从 VBA 的错误处理谈起。稍微专业一点的 VBA 代码子程序，都包含错误处理代码。大概看起来像这个样子（示例1）：

Sub Demo1()
On Error GoTo ErrorHandler
    '你的代码从这里开始

ExitProcedure:
    On Error Resume Next
    '退出前的善后工作，例如释放对象等

Exit Sub
ErrorHandler:
    MsgBox Err.Description, vbCritical, "Error From Demo1"
    Resume ExitProcedure
End Sub

这是一个最简单的错误捕捉结构，代码第2行告诉程序，发生错误，转到第11行，然后通过信息对话框显示这个错误的描述给用户，用户看完这个描述，点“确定”按钮，程序转到去执行第6行的代码。第6行代码告诉程序，如果再次发生错误，直接忽略掉，继续执行后续的代码，直到遇到“Exit Sub”后，结束整个子程序。

在示例1中，遇到任何错误，都执行相同的错误处理办法。这也是我早期一直使用的结构。

我目前使用的结构是下面的样子（示例2）：

Public Sub Demo2()
    On Error GoTo ErrorHandler
    '你的代码

ExitProcedure:
    On Error Resume Next
    '退出前的善后工作，例如释放对象等

Exit Sub
ErrorHandler:
    Select Case Err.Number
    '预期的错误代码处理方式

    Case Else	'预期以外的错误处理
        Call UnexpectedError(Err.Number, Err.Description, _
                               Err.Source & ".代码模块名.Demo2")
    End Select
End Sub

示例2中，你可以将预期中的各种错误，用不同的方式去处理。预期以外的错误，用一个叫做 UnexpectedError 的函数去统一处理。我使用这个函数，将所有预期意外的错误都记录了到一个错误表中，存储到 Access 前台客户端，在用户退出客户端时，将该用户的记录数据传递到后台数据中。这样我就得到所有用户的意外错误。然后去分析到底发生了什么事情，进而进一步去改进自己的程序。

关于VBA的错误处理相关的知识和技巧还有很多，不过这不是本文要谈论的重点。

---

楼差点盖歪了。现在进入主题。

话说这种错误处理的结构，好用确实是好用。但是，给你写的每一个函数，子程序，例如100个，都套用这种结构，这可是一件不小的体力活。你注意到没有？示例1中的“Error from Demo1”和示例2中的“.代码模块名.Demo2”，你虽然可以复制粘贴大部分的结构，但是这2块，是需要将当前的子程序的名字和所在的代码模块的名字写入进来的。这意味着你复制粘贴完之后，还需要修改这个2个地方。

如果你觉得才2个地方而已，你打字速度快的话，2秒就解决了。好吧，为避免不愉快发生，下面的内容你可以不用看了。

我时常在想，“码农”这个词汇的意味着什么。它至少意味着一点，就是你做的事情没啥技术含量，肯吃苦的人都能干。你复制粘贴100次，花200秒的时间，这件事情谁不会干？

如果不甘心做“码农”，想从这件非常机械的事情中解放出来的话，恭喜你，下面的内容就是为你而写。（哎，这文章写的真累。。。前戏做得有点太久。。。）

---

我们直奔主题。

让VBA代码直接去生成这个错误捕捉结构！

Public Enum BldType1
    jhFunction = 1                         '所建立的子程序类型是函数
    jhsub = 2                          '做建立的使子程序
End Enum
Public Enum BldType2
    jhPublic = 1                         '所建立的子程序是公有
    jhPrivate = 2                          '所建立的子程序是私有
End Enum

'该子程序在当前活动模块的最下面添加一段以参数命名的函数结构
Public Sub bldfunc(ByRef lstrFunctionName As String, ByVal ltype1 As BldType1, ByVal ltype2 As BldType2)
    On Error GoTo ErrorHandler
    Dim objModule As Access.Module
    Set objModule = Application.Modules.Item(Application.VBE.ActiveCodePane.CodeModule.Parent.Name)
    With objModule
        .InsertLines .CountOfLines + 1, ""
        .InsertLines .CountOfLines + 1, IIf(ltype2 = jhPublic, "Public ", "Private ") & _
                IIf(ltype1 = jhFunction, "Function ", "Sub ") & lstrFunctionName & "() " & IIf(ltype1 = jhFunction, "As Boolean", "")
        .InsertLines .CountOfLines + 1, "    On Error GoTo ErrorHandler"
        .InsertLines .CountOfLines + 1, "    "
        .InsertLines .CountOfLines + 1, "    '程序代码从这儿开始"
        .InsertLines .CountOfLines + 1, "    "
        .InsertLines .CountOfLines + 1, "    "
        If ltype1 = jhFunction Then .InsertLines .CountOfLines + 1, "    " & lstrFunctionName & "=True"
        .InsertLines .CountOfLines + 1, "ExitProcedure:"
        .InsertLines .CountOfLines + 1, "    On Error Resume Next"
        .InsertLines .CountOfLines + 1, "    '清理退出代码"
        .InsertLines .CountOfLines + 1, IIf(ltype1 = jhFunction, "Exit Function", "Exit Sub")
        .InsertLines .CountOfLines + 1, "ErrorHandler:"
        If ltype1 = jhFunction Then .InsertLines .CountOfLines + 1, "    " & lstrFunctionName & "=False"
        .InsertLines .CountOfLines + 1, "    Select Case Err.Number"
        .InsertLines .CountOfLines + 1, "    '预期中的错误"
        .InsertLines .CountOfLines + 1, "    Case Else"
        .InsertLines .CountOfLines + 1, "        Call UnexpectedError(Err.Number, Err.Description, Err.Source & " & """." & .Name & "." & lstrFunctionName & """)"
        .InsertLines .CountOfLines + 1, "    End Select"
        .InsertLines .CountOfLines + 1, "    Resume ExitProcedure"
        .InsertLines .CountOfLines + 1, IIf(ltype1 = jhFunction, "End Function", "End Sub")
    
'        DoCmd.Save acModule, .Name ': Debug.Print objModule.Name
    End With
ExitProcedure:
    On Error Resume Next
    '清理退出代码
    Set objModule = Nothing
Exit Sub
ErrorHandler:
    Select Case Err.Number
    '预期中的错误
    Case Else
        Call UnexpectedError(Err.Number, Err.Description, Err.Source & ".basFrameCodeBuildAssist.bldfunc")
    End Select
    Resume ExitProcedure
End Sub

将上述代码复制粘贴到一个标准模块中，然后进入到你想添加新子程序的模块（不论是窗体模块，还是标准模块，亦或是类模块），然后在立即窗口中，键入

bldfun “你的子程序名”, jhSub, jhPrivate

立刻就生成了你想要的结果。

---

本来文章应该就结束了。不过感觉话还没说完。

1. VBE对象让你能控制你的代码编写环境。它除了可以帮你自动写代码，应该还能干更多的事情，我目前没更多深入，如果你有，欢迎分享。
2. 用代码生成代码，这种能力，除了上述的生成错误捕捉结构外，你还能想到别的用途吗？我有一块代码，可以为表建立对应的类模块，为3层数据访问结构（表 <-> 对象 <-> 用户界面）中的对象创建类模块。你绝对不愿意为你的每张业务表，都手写200多行代码，特别是这些类结构都拥有统一的对内和对外接口的时候。

---

后记：有读者反馈说代码复制下来后，运行报错，我看了一下，确实是的。因为代码中并没有函数UnexpectedError的定义代码。当我准备把UnexpectedError的代码贴出来时，又发现代码中又调用了另外两个函数myMessageBox和GetUserName，而且还引用了项目级的条件编译常量CC_DEBUG1，外加一个表usysTblRunTimeErrorLog。为了简化，将其中一些内容重新修改了。现上传文件供大家下载用VBA代码生成VBA代码