我做Access开发有七八年了,真正让我下决心重构表单验证逻辑的,是一次不算复杂的库存管理项目。那套系统里二十多个录入窗体,每个窗体都有几十行甚至上百行散布在各控件事件里的校验代码,光“库存数量不能为负”这一个规则,就在六个窗体里复制了六遍。后来业务调整,要求改成“允许零库存但不能为负”,我加班到半夜改完所有相关窗体,结果第二天上线还是漏了一个窗体,导致用户录入了负数库存却没被拦住。从那以后我一直在想,Access表单验证能不能像后端接口校验那样,把规则和界面彻底拆开,做成一套可复用的实时验证架构。这篇文章就是那次重构的完整记录,从设计思路到具体代码,再到部署后遇到的各种坑,尽量一次讲透。
这套架构的目标很简单:让Access表单上的校验规则统一管理、触发时机可控、错误反馈一致,而且真正做到“实时”。不是等用户点保存了才告诉他哪里填错了,而是在他离开某个字段的瞬间就知道这个字段合不合法。整篇文章更适合正在做Access二次开发、或者被各种窗体校验代码折磨过的人参考,新手也能照着代码抄,但我会重点解释每个设计选择背后的原因,方便你灵活调整。
1. 为什么Access表单验证需要一套架构
如果你维护过超过五个Access窗体,大概率会遇到我说的这种状况:验证逻辑散落在各个控件的事件过程里,常见的写法是在文本框的BeforeUpdate里写If判断,不满足条件就MsgBox弹窗,然后Cancel = True把焦点拉回去。这种写法最直接的问题是规则无法复用。同一个“必填字段”规则,在A窗体里写在txtName_BeforeUpdate里,在B窗体里可能写在cboType_AfterUpdate里,每次都是复制粘贴,改一处漏一处。
还有个更隐蔽的问题:实时性差。很多项目为了让用户“少被打扰”,只把校验放在保存按钮的Click事件里,用户填了二十分钟,点保存时一次性弹出一堆错误——问题是他填第一个字段时就该被纠正了,等到最后才提示,等于让用户在脑子里维护一张错误清单。在我看来,好的表单验证体验应该是“边填边纠正”,在用户离开字段的那一瞬就把问题指出来,而不是把所有错误堆积到最后。
再一个问题是规则和界面强耦合。Access窗体本身就是可视化的,校验逻辑写在窗体事件里,天然就绑定到了具体控件上。如果想在多个窗体中统一调整错误提示风格、校验时机,你就得逐个打开窗体改代码。所以我把这次重构的目标定成四条:验证逻辑全部下沉到独立模块、规则可配置可复用、事件代码统一简化成一行调用、错误反馈由引擎统一处理。这样不管是单个窗体还是几十个窗体,维护一套规则就行,界面层代码量少到几乎可以忽略。
需要模型API调用? 免费领10W Token,多模型网关一键接入 Claude、DeepSeek 等主流模型。
2. 整体设计:把校验拆成触发、执行、反馈三层
在做这套架构之前,我先梳理了Access里一次校验从发生到反馈的完整链路。用户在一个文本框输入内容、光标离开、点击保存,这一系列动作会触发Change、KeyUp、AfterUpdate、Exit、BeforeUpdate等事件。传统写法是在这些事件里直接写校验逻辑;我的做法是把链路拆成三个独立层次——触发层、执行层、反馈层,各管一件事,互不干扰。这也是这套架构能长期维护的核心原因。
2.1 触发层:只做事件转发,不做业务判断
触发层是窗体里的每一个事件过程,它只负责把“某个控件的值被修改了”这件事告诉执行层,不包含任何业务规则判断。比如文本框txtCustomerName的AfterUpdate事件里只有一行代码:
vb复制Private Sub txtCustomerName_AfterUpdate()
Call ValidationEngine.ValidateControl(Me, "txtCustomerName")
End Sub
窗体级BeforeUpdate事件同样只有三行:
vb复制Private Sub Form_BeforeUpdate(Cancel As Integer)
If Not ValidationEngine.ValidateForm(Me) Then
Cancel = True
End If
End Sub
这种写法最大的价值在于稳定。以后业务规则怎么调整,界面层的代码几乎不用动。真正改规则的地方在独立模块里,窗体代码干净到新来的同事都能一眼看懂。我见过很多Access项目,窗体代码动辄几百上千行,想找一个字段的校验逻辑得上下翻半天,就是因为事件过程里混了太多不该写的东西。
有一个细节必须提醒:不要在Change事件里直接调用ValidateControl。用户输入过程中Change事件会触发几十次,特别是涉及数据库查询的规则,比如唯一性校验,每敲一个字符就查一次表,界面会卡得不能忍。我的策略是,Change事件里只记录“内容有变化”这个事实,真正的校验放到AfterUpdate或者Exit事件里执行。后面第三节我会专门讲这个时机控制技巧。
2.2 执行层:统一的验证规则引擎
执行层是整套架构的核心,它由两个类模块和一个标准模块构成。我习惯的命名是clsValidationRule、clsValidationEngine、modValidationEntry,职责分别如下:
| 模块 | 类型 | 职责 |
|---|---|---|
| clsValidationRule | 类模块 | 封装单条验证规则,包含目标控件、规则类型、参数、错误消息、严重级别 |
| clsValidationEngine | 类模块 | 维护规则列表,执行校验,管理反馈流程 |
| modValidationEntry | 标准模块 | 提供全局入口函数和基础校验函数,供窗体及引擎调用 |
clsValidationRule里的核心属性是这样定义的:
vb复制' clsValidationRule 类模块
Public ControlName As String ' 目标控件名称
Public RuleType As String ' required / range / length / pattern / compare / unique
Public RuleParam1 As Variant ' 规则参数1,比如数字范围的左边界
Public RuleParam2 As Variant ' 规则参数2,比如数字范围的右边界
Public ErrorMessage As String ' 校验失败时的提示消息
Public Severity As Integer ' 严重级别,1=提示 2=警告 3=阻止保存
Public IsActive As Boolean ' 是否启用该规则
拿年龄字段举例,一条规则对象就是这样构造的:
vb复制Dim rule As clsValidationRule
Set rule = New clsValidationRule
rule.ControlName = "txtAge"
rule.RuleType = "range"
rule.RuleParam1 = 18
rule.RuleParam2 = 65
rule.ErrorMessage = "年龄必须在18到65周岁之间"
rule.Severity = 3
Call engine.AddRule(rule)
执行层拿到请求后,遍历所有和目标控件匹配的规则,逐条执行。引擎根据RuleType把请求分发到具体的校验函数,比如IsRequired、IsRange、IsPattern、IsUnique。这些函数都独立存在,后续想扩展新的规则类型,只需要增加一个分支和一个函数,不需要动窗体代码。
2.3 反馈层:错误提示与界面联动
反馈层是最容易偷懒、但最影响真实体验的环节。很多Access项目校验失败直接MsgBox弹窗,用户连续点确定点到烦,而且在输入过程中被弹窗打断,上下文一下就断了。我在这套架构里把反馈分成两种场景:提交时校验失败用汇总对话框;字段实时校验失败用控件级提示,不弹窗。
控件级提示具体做的三件事:把出错控件的背景色改成浅红色,在窗体底部的固定提示标签里显示当前错误信息,同时在控件的状态栏文本(StatusBarText)里写入简短说明。用户看到红色背景就知道哪里出错了,看底部标签或者状态栏就知道错在哪。整个过程零打断,体验顺滑很多。
这里容易忽略的一步是清错恢复。校验通过后,引擎必须把之前加在控件上的红色背景和提示文字清掉,否则用户改完内容错误已经解决,控件还留着红色,让人误以为还有问题。这个“清除错误状态”的动作必须和校验动作联动,不能等下一次校验再顺手清,否则会有视觉残留。
3. 核心实现:验证引擎的搭建过程
这节直接上代码。我会把完整引擎从无到有写出来,包括类模块和标准模块的完整实现,然后解释每个关键方法的设计理由。你照着建三个模块,再把窗体上的事件调用补上,就能跑起来。
3.1 构建clsValidationRule类模块
在Access的Visual Basic编辑器里,新建一个类模块,改名为clsValidationRule。这个类很简单,就是定义一条规则需要的数据结构。
vb复制Option Explicit
Public ControlName As String
Public RuleType As String
Public RuleParam1 As Variant
Public RuleParam2 As Variant
Public ErrorMessage As String
Public Severity As Integer
Public IsActive As Boolean
Private Sub Class_Initialize()
Severity = 3
IsActive = True
End Sub
把Severity默认值设为3是有讲究的。在实际项目中,大部分规则都是硬性校验,默认阻止保存最安全。但有时候业务上会有“软提醒”,比如邮箱格式不规范但万不得已可以保存,这时候把Severity改成1或2,引擎就知道这条校验失败不一定要拦下保存。IsActive的用处也很实际,业务上经常出现“临时停用某条规则”的需求,直接在引擎初始化时把某条规则的IsActive设为False,比删掉规则对象再重新加回来方便得多,恢复了再改回True就行。
3.2 实现clsValidationEngine类模块
再新建一个类模块,改名为clsValidationEngine。这个类负责管理所有规则对象,并对外提供ValidateControl和ValidateForm两个核心方法。
vb复制Option Explicit
Private m_rules As Collection
Private m_lastErrors As Collection
Private m_isValidating As Boolean
Private Sub Class_Initialize()
Set m_rules = New Collection
Set m_lastErrors = New Collection
m_isValidating = False
End Sub
Public Sub AddRule(rule As clsValidationRule)
m_rules.Add rule
End Sub
Public Sub ClearRules()
Set m_rules = New Collection
End Sub
Public Function ValidateControl(frm As Form, controlName As String) As Boolean
Dim rule As clsValidationRule
Dim result As Boolean
Dim errorMsg As String
' 防止重入导致死循环
If m_isValidating Then
ValidateControl = True
Exit Function
End If
m_isValidating = True
ValidateControl = True
ClearControlError frm, controlName
For Each rule In m_rules
If rule.IsActive And rule.ControlName = controlName Then
result = ExecuteRule(rule, frm)
If Not result Then
AddError rule, controlName
ValidateControl = False
End If
End If
Next rule
If Not ValidateControl Then
errorMsg = GetControlErrorMsg(controlName)
ShowControlError frm, controlName, errorMsg
End If
m_isValidating = False
End Function
Public Function ValidateForm(frm As Form) As Boolean
Dim rule As clsValidationRule
Dim controlName As String
Dim result As Boolean
If m_isValidating Then
ValidateForm = True
Exit Function
End If
m_isValidating = True
ValidateForm = True
Set m_lastErrors = New Collection
For Each rule In m_rules
If rule.IsActive Then
controlName = rule.ControlName
result = ExecuteRule(rule, frm)
If Not result Then
AddError rule, controlName
ValidateForm = False
End If
End If
Next rule
If Not ValidateForm Then
ShowSummaryError frm
End If
m_isValidating = False
End Function
这段代码里有几个细节必须说明。第一,ValidateControl和ValidateForm都在同一轮校验里把所有错误收集完,而不是遇到第一个错误就返回False。假设用户同时填错了五个字段,一次提交告诉他五处错误,远比他改一次提交一次高效。第二,m_isValidating防重入标志是我踩过死循环的坑之后加上的,理由在后文第6.2节详细讲。第三,ClearControlError在每次校验开头都会执行,确保上次遗留的错误提示被清掉,这样可以避免视觉残留。
3.3 规则分发与基础校验函数
ExecuteRule负责把规则分发给具体的校验函数,是整个引擎的“路由器”。它用Select Case区分规则类型,这里我把基础校验函数放在标准模块modValidationEntry里,方便项目其它地方复用。
vb复制Private Function ExecuteRule(rule As clsValidationRule, frm As Form) As Boolean
Dim ctl As Control
Dim value As Variant
On Error GoTo errHandler
Set ctl = frm.Controls(rule.ControlName)
value = ctl.Value
Select Case rule.RuleType
Case "required"
ExecuteRule = modValidationEntry.IsRequired(value)
Case "range"
ExecuteRule = modValidationEntry.IsRange(value, rule.RuleParam1, rule.RuleParam2)
Case "length"
ExecuteRule = modValidationEntry.IsLength(value, rule.RuleParam1, rule.RuleParam2)
Case "pattern"
ExecuteRule = modValidationEntry.IsPattern(value, rule.RuleParam1)
Case "compare"
ExecuteRule = modValidationEntry.IsCompare(rule.RuleParam1, value, rule.RuleParam2, frm)
Case "unique"
ExecuteRule = modValidationEntry.IsUnique(rule.RuleParam1, rule.RuleParam2, value, frm)
Case Else
ExecuteRule = True
End Select
Exit Function
errHandler:
ExecuteRule = False
End Function
对应的标准模块modValidationEntry里,我写这些基础校验函数:
vb复制Public Function IsRequired(value As Variant) As Boolean
If IsNull(value) Or value = "" Then
IsRequired = False
Else
IsRequired = True
End If
End Function
Public Function IsRange(value As Variant, minVal As Variant, maxVal As Variant) As Boolean
If IsNull(value) Or Not IsNumeric(value) Then
IsRange = False
Exit Function
End If
If value < minVal Or value > maxVal Then
IsRange = False
Else
IsRange = True
End If
End Function
Public Function IsLength(value As Variant, minLen As Long, maxLen As Long) As Boolean
Dim lenVal As Long
If IsNull(value) Then
IsLength = False
Exit Function
End If
lenVal = Len(CStr(value))
If lenVal < minLen Or lenVal > maxLen Then
IsLength = False
Else
IsLength = True
End If
End Function
Public Function IsPattern(value As Variant, pattern As String) As Boolean
Dim reg As Object
If IsNull(value) Or value = "" Then
IsPattern = False
Exit Function
End If
Set reg = CreateObject("VBScript.RegExp")
reg.Pattern = pattern
reg.IgnoreCase = True
IsPattern = reg.Test(CStr(value))
End Function
Public Function IsCompare(compareControlName As String, value As Variant, compareType As String, frm As Form) As Boolean
Dim otherValue As Variant
otherValue = frm.Controls(compareControlName).Value
Select Case compareType
Case "equal"
IsCompare = (CStr(value) = CStr(otherValue))
Case "notEqual"
IsCompare = (CStr(value) <> CStr(otherValue))
Case "greaterThan"
If IsNull(value) Or IsNull(otherValue) Then
IsCompare = False
ElseIf value > otherValue Then
IsCompare = True
Else
IsCompare = False
End If
Case "lessThan"
If IsNull(value) Or IsNull(otherValue) Then
IsCompare = False
ElseIf value < otherValue Then
IsCompare = True
Else
IsCompare = False
End If
Case Else
IsCompare = True
End Select
End Function
说一下正则校验的实现细节。这里我用了CreateObject("VBScript.RegExp")而不是通过菜单“引用”里勾选Microsoft VBScript Regular Expressions 5.5。这么做主要是为了部署省心。Access项目经常要复制到客户的电脑上运行,如果工程里引用了不存在的组件库,打开时就可能报编译错误,而CreateObject是运行时创建对象,只要目标机器有VBScript引擎(Windows自带),就不会出问题。代价是写代码时没有带点号的智能提示,正则语法只能自己记,但换来的是部署兼容性,我觉得值。
3.4 反馈层方法的完整实现
有了校验结果,接下来是反馈。我在clsValidationEngine里补充这些方法:ClearControlError、ShowControlError、ShowSummaryError、AddError、GetControlErrorMsg。
vb复制Private Sub ClearControlError(frm As Form, controlName As String)
Dim ctl As Control
On Error Resume Next
Set ctl = frm.Controls(controlName)
ctl.BackColor = vbWhite
If Not IsNull(frm("lblValidationMsg")) Then
If frm("lblValidationMsg").Caption = GetControlErrorMsg(controlName) Then
frm("lblValidationMsg").Caption = ""
End If
End If
On Error GoTo 0
End Sub
Private Sub ShowControlError(frm As Form, controlName As String, errorMsg As String)
Dim ctl As Control
On Error Resume Next
Set ctl = frm.Controls(controlName)
ctl.BackColor = RGB(255, 204, 204)
If Not IsNull(frm("lblValidationMsg")) Then
frm("lblValidationMsg").Caption = errorMsg
frm("lblValidationMsg").Visible = True
End If
On Error GoTo 0
End Sub
Private Sub ShowSummaryError(frm As Form)
Dim i As Integer
Dim msg As String
Dim item As Variant
Dim ctl As Control
msg = "以下字段需要修改:" & vbCrLf
For i = 1 To m_lastErrors.Count
item = m_lastErrors(i)
msg = msg & i & ". " & item(0) & "(" & item(1) & ")" & vbCrLf
On Error Resume Next
Set ctl = frm.Controls(CStr(item(0)))
ctl.BackColor = RGB(255, 204, 204)
On Error GoTo 0
Next i
MsgBox msg, vbExclamation, "表单验证未通过"
End Sub
Private Sub AddError(rule As clsValidationRule, controlName As String)
Dim item(1 To 2) As Variant
item(1) = controlName
item(2) = rule.ErrorMessage
m_lastErrors.Add item
End Sub
Private Function GetControlErrorMsg(controlName As String) As String
Dim i As Integer
Dim item As Variant
For i = 1 To m_lastErrors.Count
item = m_lastErrors(i)
If CStr(item(0)) = controlName Then
GetControlErrorMsg = CStr(item(1))
Exit Function
End If
Next i
GetControlErrorMsg = ""
End Function
m_lastErrors集合里存的是Variant数组,数组下标从1开始,这容易踩坑,因为VBA里的动态数组默认下标从0开始,我这里用Dim item(1 To 2)显式声明了上下界。如果你不习惯这种方式,可以单独写一个clsValidationError类,字段就是ControlName和ErrorMessage,逻辑更清晰,但代码量会多一截。
3.5 在窗体中注册规则与调用引擎
引擎写完之后,需要在具体窗体里实例化并注册规则。我习惯在每个数据录入窗体模块顶部声明模块级变量cEngine,在Form_Load时完成初始化。
vb复制' 窗体模块顶部
Private cEngine As clsValidationEngine
Private Sub Form_Load()
Set cEngine = New clsValidationEngine
Call SetupValidationRules(cEngine)
End Sub
Private Sub SetupValidationRules(engine As clsValidationEngine)
Dim rule As clsValidationRule
Set rule = New clsValidationRule
rule.ControlName = "txtCustomerName"
rule.RuleType = "required"
rule.ErrorMessage = "客户名称不能为空"
rule.Severity = 3
engine.AddRule rule
Set rule = New clsValidationRule
rule.ControlName = "txtMobile"
rule.RuleType = "pattern"
rule.RuleParam1 = "^1[3-9]\d{9}$"
rule.ErrorMessage = "手机号格式不正确,请输入11位手机号"
rule.Severity = 3
engine.AddRule rule
Set rule = New clsValidationRule
rule.ControlName = "txtOrderDate"
rule.RuleType = "range"
rule.RuleParam1 = CDate("2020-01-01")
rule.RuleParam2 = Date
rule.ErrorMessage = "下单日期不能早于2020年,也不能晚于今天"
rule.Severity = 3
engine.AddRule rule
Set rule = New clsValidationRule
rule.ControlName = "txtConfirmPassword"
rule.RuleType = "compare"
rule.RuleParam1 = "txtPassword"
rule.RuleParam2 = "equal"
rule.ErrorMessage = "两次输入的密码不一致"
rule.Severity = 3
engine.AddRule rule
End Sub
控件的AfterUpdate事件代码很简单:
vb复制Private Sub txtCustomerName_AfterUpdate()
Call cEngine.ValidateControl(Me, "txtCustomerName")
End Sub
窗体的BeforeUpdate事件里调用整体校验:
vb复制Private Sub Form_BeforeUpdate(Cancel As Integer)
If Not cEngine.ValidateForm(Me) Then
Cancel = True
End If
End Sub
到这里,一套基于规则引擎的Access表单验证架构已经能跑起来了。看起来工程量不小,但拆到每个窗体时其实只需要做三件事:在Form_Load里写规则注册、在控件AfterUpdate里加一行召唤、在Form_BeforeUpdate里加三行兜底。
4. 实时校验的触发时机与控制技巧
架构搭好之后,真正决定用户体验好坏的是触发时机。这里说的“实时”,不是字面上“按下每颗键都验证”,而是在用户完成当前字段输入、即将离开时立刻给出反馈。这个分寸拿捏不好,要么卡顿得让人暴躁,要么提示太晚让人感觉形同虚设。
4.1 不同控件类型该用哪个事件
文本框,我建议用AfterUpdate而不用Change。Access的AfterUpdate会在控件失去焦点或按回车时触发,恰好是“用户对于这个字段的输入告一段落”的信号。此时校验,既能及时发现错误,又不会因为频繁触发导致卡顿。Change事件适合用于动态联动,比如根据客户类型切换某些字段的可用状态,但不适合做校验。
组合框就用AfterUpdate。它的值在用户选择后才确定,AfterUpdate时机合适。如果组合框允许用户手动输入值,还要配合NotInList事件,在用户输入了列表外的值时给出提示或自动触发相关规则。
复选框和选项组,用Click事件或AfterUpdate事件都行。Access里复选框的Change事件在某些版本下表现不稳定,Click更可靠。
子窗体里的控件,需要在子窗体的对应事件里调用引擎。如果主窗体保存时要校验子窗体所有控件,可以枚举子窗体的Controls集合,逐个调用ValidateControl,或者给子窗体增加一个公开的Validate方法,在主窗体保存时调用。这个做法在第5.3节会展开讲。
4.2 用防抖机制降低查询型校验的频率
实时校验最常见的问题出在“查询型校验”上,典型就是“客户名称不能重复”这种需要查表的规则。如果每次AfterUpdate都执行一次DCount查询,数据量一大,用户切换字段的瞬间就会感到明显卡顿。我的方案是用Access的Form_Timer事件做一个简单防抖,核心思路是“用户停止输入一段时间后才真正执行校验”。
vb复制' 窗体模块变量
Private m_pendingControl As String
Private Sub txtCustomerName_Change()
m_pendingControl = "txtCustomerName"
Me.TimerInterval = 800
End Sub
Private Sub Form_Timer()
Me.TimerInterval = 0
If m_pendingControl <> "" Then
Call cEngine.ValidateControl(Me, m_pendingControl)
m_pendingControl = ""
End If
End Sub
这里的逻辑是:用户每敲一个字符,Change事件就触发一次,把TimerInterval重置为800毫秒。只有他停止输入超过800毫秒后,Form_Timer才会触发一次,执行真正的校验。这样数据库查询的压力从“每敲一个字符查一次”降成“停顿后查一次”,用户体验提升非常明显。
有朋友可能担心:如果用户输入完马上点保存,800毫秒还没到,Form_Timer还没触发,重复校验是不是就漏了?不会,因为保存时Form_BeforeUpdate会调用ValidateForm做全量校验,这是最终防线。防抖只影响实时反馈的触发时机,不影响数据完整性。
4.3 焦点顺序与提示信息的配合
这一点容易忽略,但影响很大。如果窗体上控件的TabIndex混乱,用户按Tab跳转的顺序和他实际填写的顺序不一致,就会出现“手机号校验还没反应,焦点已经跳到地址栏了”的糟糕体验。所以在做窗体布局时,必须把TabIndex按用户填写顺序排好,这是实时校验体验的基础。
提示信息的位置同样重要。我一般会在窗体底部固定一个lblValidationMsg标签,设置成浅黄背景,用于显示当前控件的错误信息。同时,我会在错误控件的StatusBarText属性里写入同一句错误说明,这样即使焦点已经跳到别的控件,用户也能在Access窗口左下角的状态栏看到刚才字段的错误原因。StatusBarText是Access控件自带属性,设置后控件获得焦点时会自动显示,不需要额外代码,这是一个很省事的技巧。
5. 验证规则的扩展:业务逻辑与数据库联动
基础引擎跑通后,最常遇到的就是“需要查表”的业务规则。这种规则如果直接写进引擎,会把通用校验和具体业务耦合在一起,以后引擎就不能复用了。我的做法是:引擎保持通用,业务规则放在独立的业务模块里,通过增加RuleType分支来调用。
5.1 唯一性校验的完整实现
一个典型的“唯一性校验”,比如客户名称不能重复,可以这样实现:
vb复制Public Function IsUnique(tableName As String, fieldName As String, value As Variant, frm As Form) As Boolean
Dim criteria As String
' 用值构造查询条件,注意转义单引号避免SQL错误
criteria = "[" & fieldName & "] = '" & Replace(CStr(value), "'", "''") & "'"
' 编辑已有记录时,要排除当前记录自身
If Not IsNull(frm("ID")) Then
criteria = criteria & " AND [ID] <> " & frm("ID").Value
End If
If DCount("*", tableName, criteria) > 0 Then
IsUnique = False
Else
IsUnique = True
End If
End Function
然后在ExecuteRule的Select Case里增加一个分支:
vb复制Case "unique"
ExecuteRule = modValidationEntry.IsUnique(rule.RuleParam1, rule.RuleParam2, value, frm)
这样引擎的代码保持通用,业务规则集中管理,看起来很简单。但是这里有个必须强调的点:DCount做唯一性校验只能用于前台实时提示,不能替代数据库表字段的唯一索引。因为如果两个用户同时提交相同的客户名称,两边都通过了DCount检查,最后数据表里照样会出现重复记录。真正的唯一性保障,一定要在表字段设计上建立唯一索引。这个原则我每次做项目都反复跟团队强调,实时校验只是提升体验,数据库约束才是数据完整性底线。
5.2 联表存在性校验
另一个常见场景是“外键存在性”校验,比如订单里的客户编号必须存在于客户表。这种校验用DLookup或DCount就能实现:
vb复制If IsNull(DLookup("[CustomerID]", "tblCustomer", "[CustomerID]=" & value)) Then
' 客户不存在,校验失败
End If
如果查询条件很复杂,我建议直接在Access里建一个查询对象,然后用DCount("1", "qrySomeValidationQuery", criteria)去查。这样复杂的SQL逻辑留在查询设计器里维护,VBA代码保持干净,业务人员甚至都能看懂查询条件。
5.3 跨窗体批量验证
主从表结构是Access开发里的重头戏。比如订单主窗体下面挂一个订单明细子窗体,用户点保存时,不仅要校验主窗体字段,还要校验子窗体里所有明细行的数据。这种场景不能在Form_BeforeUpdate里只调用ValidateForm,因为主窗体的ValidateForm并不了解子窗体里的记录集。
我的做法是给主窗体增加一个公开函数ValidateAll,里面依次完成主窗体校验和子窗体记录集逐行校验:
vb复制Public Function ValidateAll() As Boolean
Dim result As Boolean
Dim rs As DAO.Recordset
result = True
If Not cEngine.ValidateForm(Me) Then
result = False
End If
If Not IsNull(Me.frmOrderDetail.Form) Then
Set rs = Me.frmOrderDetail.Form.RecordsetClone
If Not rs.BOF Then rs.MoveFirst
Do While Not rs.EOF
If IsNull(rs("ProductID")) Or rs("Quantity") <= 0 Then
result = False
Exit Do
End If
rs.MoveNext
Loop
rs.Close
End If
ValidateAll = result
End Function
然后保存按钮和窗体的BeforeUpdate都改成调用ValidateAll。这里有一个关键细节:直接遍历子窗体的RecordsetClone不会影响当前显示,也不需要移动当前记录指针,比较安全。但如果要对子窗体的当前记录做校验,确保用的是Form.Recordset而不是RecordsetClone,否则指针移动会打乱用户正在编辑的界面状态。
6. 实际项目中的问题排查与避坑记录
代码写完不等于架构稳定,真正的问题往往藏在细节里。我把这套架构部署到真实项目后,遇到的典型问题整理成了速查表,后面再挑几个重点展开。
| 现象 | 可能原因 | 解决方案 |
|---|---|---|
| 控件事件里调用ValidateControl |
