OrFlying VB6版产生的代码示例

鉴于VB6依然在使用，VB6的代码和工具我也将进行介绍和公布：

VB6：Class示例

Option Explicit

'属性声明
Private mEmployeeID As String
Private mEmployeeName As String
Private mGender As String
Private mDeptID As String
Private mPassword As String
Private mPositionID As String
Private mUserGroup As String
Private mCalendarUniqueID As Integer
Private mDefaultDeviceID As String
Private mEmployeeType As Integer
Private mLiteracy As String
Private mBirth As Date
Private mWorkCenterID As String
Private mEmployeeEmail As String
Private mEmployeeSmsID As String
Private mStrMsg As String '返回错误信息
Private mIsNew As Boolean '是否为新建对象，需要插入数据库
Private mDirty As Boolean '是否修改对象，需要更新到数据库
Private mClassStorage As Boolean '用于判断是否需要校验
Private mDeleteFlag As Boolean '是否为删除，需要更新到数据库

'属性过程
Public Property Let EmployeeID(ByVal vData As String)
mEmployeeID = vData
End Property

Public Property Get EmployeeID() as String
EmployeeID = mEmployeeID
End Property

Public Property Let EmployeeName(ByVal vData As String)
mEmployeeName = vData
End Property

Public Property Get EmployeeName() as String
EmployeeName = mEmployeeName
End Property

Public Property Let Gender(ByVal vData As String)
mGender = vData
End Property

Public Property Get Gender() as String
Gender = mGender
End Property

Public Property Let DeptID(ByVal vData As String)
mDeptID = vData
End Property

Public Property Get DeptID() as String
DeptID = mDeptID
End Property

Public Property Let Password(ByVal vData As String)
mPassword = vData
End Property

Public Property Get Password() as String
Password = mPassword
End Property

Public Property Let PositionID(ByVal vData As String)
mPositionID = vData
End Property

Public Property Get PositionID() as String
PositionID = mPositionID
End Property

Public Property Let UserGroup(ByVal vData As String)
mUserGroup = vData
End Property

Public Property Get UserGroup() as String
UserGroup = mUserGroup
End Property

Public Property Let CalendarUniqueID(ByVal vData As Integer)
mCalendarUniqueID = vData
End Property

Public Property Get CalendarUniqueID() as Integer
CalendarUniqueID = mCalendarUniqueID
End Property

Public Property Let DefaultDeviceID(ByVal vData As String)
mDefaultDeviceID = vData
End Property

Public Property Get DefaultDeviceID() as String
DefaultDeviceID = mDefaultDeviceID
End Property

Public Property Let EmployeeType(ByVal vData As Integer)
mEmployeeType = vData
End Property

Public Property Get EmployeeType() as Integer
EmployeeType = mEmployeeType
End Property

Public Property Let Literacy(ByVal vData As String)
mLiteracy = vData
End Property

Public Property Get Literacy() as String
Literacy = mLiteracy
End Property

Public Property Let Birth(ByVal vData As Date)
mBirth = vData
End Property

Public Property Get Birth() as Date
Birth = mBirth
End Property

Public Property Let WorkCenterID(ByVal vData As String)
mWorkCenterID = vData
End Property

Public Property Get WorkCenterID() as String
WorkCenterID = mWorkCenterID
End Property

Public Property Let EmployeeEmail(ByVal vData As String)
mEmployeeEmail = vData
End Property

Public Property Get EmployeeEmail() as String
EmployeeEmail = mEmployeeEmail
End Property

Public Property Let EmployeeSmsID(ByVal vData As String)
mEmployeeSmsID = vData
End Property

Public Property Get EmployeeSmsID() as String
EmployeeSmsID = mEmployeeSmsID
End Property

Public Property Let IsNew(ByVal vData As Boolean)
mIsNew = vData
End Property

Public Property Get IsNew() as Boolean
IsNew = mIsNew
End Property

Public Property Let Dirty(ByVal vData As Boolean)
mDirty = vData
End Property

Public Property Get Dirty() as Boolean
Dirty = mDirty
End Property

Public Property Let DeleteFlag(ByVal vData As Boolean)
mDeleteFlag = vData
End Property

Public Property Get DeleteFlag() as Boolean
DeleteFlag = mDeleteFlag
End Property

Public Property Let ClassStorage(ByVal vData As Boolean)
mClassStorage = vData
End Property

Public Property Get ClassStorage() as Boolean
ClassStorage = mClassStorage
End Property

VB6：Collection示例

Option Explicit

'集合的内部变量
Private mCol As New Collection

'存储错误信息的内部属性
Private mStrMsg As String

'表示该实例是否为变化
Private mIsChange As Boolean

'存储Fill Collection的SQL语句
Private mCreateSQL As String

'存储Fill Collection的SQL语句
Private mUpdateSQL As String

'获得集合的元素的数目
' Syntax: Debug.Print x.Count
Public Property Get Count() As Long
Count = mCol.Count
End Property

Public Property Get Item(vntIndexKey As Variant) As CEmployee
Attribute Item.VB_UserMemId = 0
mStrMsg = ""
Set Item = mCol(vntIndexKey)
End Property

Public Property Get NewEnum() As IUnknown
Attribute NewEnum.VB_UserMemId = -4
Set NewEnum = mCol.[_NewEnum]
End Property

'往集合里面添加一个项目的时候
Public Function Add(Item As CEmployee, Optional Key As Variant) As Boolean
On Error GoTo ErrorHandler
Add = False
mStrMsg = ""

If IsMissing(Key) Then
mCol.Add Item
Else
mCol.Add Item, Key
End If
Add = True
Exit Function
ErrorHandler:
mStrMsg = "Add: 发生意外错误 " & mStrMsg & vbCrLf & Err.Description
On Error GoTo 0
End Function

Public Function Remove(vntIndexKey As Variant) As Boolean
On Error GoTo ErrorHandler
Remove = False
mStrMsg = ""
mCol.Remove vntIndexKey
Remove = True
Exit Function
ErrorHandler:
mStrMsg = "Remove: 发生意外错误 " & mStrMsg & vbCrLf & Err.Description
On Error GoTo 0
End Function

Public Function GetClsMsg() As String
On Error GoTo ErrorHandler
GetClsMsg = mStrMsg
Exit Function
ErrorHandler:
mStrMsg = "GetClsMsg: 发生意外错误 " & mStrMsg & vbCrLf & Err.Description
On Error GoTo 0
End Function

Public Function Clear() As Boolean
On Error GoTo ErrorHandler
Clear = False
mStrMsg = ""
'清空集合
Set mCol = Nothing
'重新创建集合
Set mCol = New Collection
Clear = True
Exit Function
ErrorHandler:
mStrMsg = "Clear: 发生意外错误 " & mStrMsg & vbCrLf & Err.Description
On Error GoTo 0
End Function

'取消删除标记
Public Function UnMarkForDelete(Optional ByVal Index As Variant) As Boolean
On Error GoTo ErrorHandler
UnMarkForDelete = False
mStrMsg = ""
Dim LowerLimit As Long
Dim UpperLimit As Long
Dim inx As Long
'Check Index
If Not IsMissing(Index) Then
If (Not IsNumeric(Index)) Or (Index < 1 Or Index > Me.Count) Then
mStrMsg = mStrMsg & "方法：MarkForDelete 索引Index超出边界 "
Exit Function
End If
'Toggle DeleteFlag
Me.Item(Index).DeleteFlag = False
Else
LowerLimit = 1
UpperLimit = Me.Count
For inx = LowerLimit To UpperLimit
Me.Item(inx).DeleteFlag = False
Next
End If
UnMarkForDelete = True
Exit Function
ErrorHandler:
mStrMsg = "UnMarkForDelete: 发生意外错误 " & mStrMsg & vbCrLf & Err.Description
On Error GoTo 0
End Function

'标记删除标志，可以针对一个Item,也可以是所有的Item
Public Function MarkForDelete(Optional ByVal Index As Variant) As Boolean
On Error GoTo ErrorHandler
MarkForDelete = False
mStrMsg = ""
Dim LowerLimit As Long
Dim UpperLimit As Long
Dim inx As Long
If Not IsMissing(Index) Then
'检查Index是否正确
If (Not IsNumeric(Index)) Or (Index < 1 Or Index > Me.Count) Then
mStrMsg = mStrMsg & "方法：MarkForDelete 索引Index超出边界 "
Exit Function
End If
'设定删除标记
Me.Item(Index).DeleteFlag = True
Else
LowerLimit = 1
UpperLimit = Me.Count
For inx = LowerLimit To UpperLimit
Me.Item(inx).DeleteFlag = True
Next
End If
MarkForDelete = True
MarkForDelete = True
Exit Function
ErrorHandler:
mStrMsg = "MarkForDelete: 发生意外错误 " & mStrMsg & vbCrLf & Err.Description
On Error GoTo 0
End Function

Public Property Let IsChange(ByVal vData As Boolean)
mIsChange = vData
End Property

Public Property Get IsChange() As Boolean
IsChange = mIsChange
End Property

Public Property Let CreateSQL(ByVal vData As String)
mCreateSQL = vData
End Property

Public Property Get CreateSQL() As String
CreateSQL = mCreateSQL
End Property

Public Property Let UpdateSQL(ByVal vData As String)
mUpdateSQL = vData
End Property

Public Property Get UpdateSQL() As String
UpdateSQL = mUpdateSQL
End Property

VB6：Engine示例

Option Explicit

'返回类内部消息的变量
Private mStrMsg As String

Private Date_Init As Date
Public Function GetClsMsg() As String
GetClsMsg = mStrMsg
End Function

Public Function GetEmployee(iStrEmployeeID As String, oClsEmployee As CEmployee, iIsCulAvail As Integer) As Boolean
On Error GoTo ErrorHandler
GetEmployee = False

iIsCulAvail = 1
Dim rstTmp As New ADODB.Recordset
Dim cnTmp As New CMMCn
Dim clsEmployee As New CEmployee
rstTmp.Open "Select * from Employee Where EmployeeID=" & iStrEmployeeID, cnTmp.Connect
If rstTmp.BOF Or rstTmp.EOF Then
Set oClsEmployee = New CEmployee
iIsCulAvail = 0
mStrMsg = "GetEmployee:找不到相关记录！"
GoTo RightExit
End If
rstTmp.MoveFirst
If Not TransEmployeeRTC(rstTmp, clsEmployee) Then
mStrMsg = "GetEmployee:" & mStrMsg
GoTo CleanExit
End If
Set oClsEmployee = clsEmployee
Set cnTmp = Nothing
Set rstTmp = Nothing
RightExit:
GetEmployee = True
CleanExit:
Exit Function

ErrorHandler:
mStrMsg = "GetEmployee: 发生意外错误 " & mStrMsg & vbCrLf & Err.Description
On Error GoTo 0
End Function

Public Function GetEmployeeS(oColEmployeeS As CEmployeeS, iStrCondition As String) As Boolean
On Error GoTo ErrorHandler
GetEmployeeS = False

Dim rstTmp As New ADODB.Recordset
Dim cnTmp As New CMMCn
Dim clsEmployeeS As New CEmployeeS
Dim clsEmployee As New CEmployee
If iStrCondition = "" Then iStrCondition = " 1=1 "
rstTmp.Open "Select * from Employee Where " & iStrCondition, cnTmp.Connect
If rstTmp.BOF Or rstTmp.EOF Then
Set oColEmployeeS = New CEmployeeS
mStrMsg = "GetEmployeeS:找不到相关记录！"
GoTo RightExit
End If
rstTmp.MoveFirst
Do
With clsEmployee
.EmployeeID = IIf(IsNull(rstTmp("EmployeeID")), "", rstTmp("EmployeeID"))
.EmployeeName = IIf(IsNull(rstTmp("EmployeeName")), "", rstTmp("EmployeeName"))
.Gender = IIf(IsNull(rstTmp("Gender")), "", rstTmp("Gender"))
.DeptID = IIf(IsNull(rstTmp("DeptID")), "", rstTmp("DeptID"))
.Password = IIf(IsNull(rstTmp("Password")), "", rstTmp("Password"))
.PositionID = IIf(IsNull(rstTmp("PositionID")), "", rstTmp("PositionID"))
.UserGroup = IIf(IsNull(rstTmp("UserGroup")), "", rstTmp("UserGroup"))
.CalendarUniqueID = IIf(IsNull(rstTmp("CalendarUniqueID")), 0, rstTmp("CalendarUniqueID"))
.DefaultDeviceID = IIf(IsNull(rstTmp("DefaultDeviceID")), "", rstTmp("DefaultDeviceID"))
.EmployeeType = IIf(IsNull(rstTmp("EmployeeType")), 0, rstTmp("EmployeeType"))
.Literacy = IIf(IsNull(rstTmp("Literacy")), "", rstTmp("Literacy"))
.Birth = IIf(IsNull(rstTmp("Birth")), Date_Init, rstTmp("Birth"))
.WorkCenterID = IIf(IsNull(rstTmp("WorkCenterID")), "", rstTmp("WorkCenterID"))
.EmployeeEmail = IIf(IsNull(rstTmp("EmployeeEmail")), "", rstTmp("EmployeeEmail"))
.EmployeeSmsID = IIf(IsNull(rstTmp("EmployeeSmsID")), "", rstTmp("EmployeeSmsID"))
End With

If Not clsEmployeeS.Add(clsEmployee, CStr(clsEmployee.EmployeeID)) Then
mStrMsg = "GetEmployeeS" & clsEmployeeS.GetClsMsg
GoTo CleanExit
End If
Set clsEmployee = Nothing
Set clsEmployee = New CEmployee
rstTmp.MoveNext
Loop Until rstTmp.EOF
Set oColEmployeeS = clsEmployeeS
Set cnTmp = Nothing
Set rstTmp = Nothing
RightExit:
GetEmployeeS = True
CleanExit:
Exit Function

ErrorHandler:
mStrMsg = "GetEmployeeS: 发生意外错误 " & mStrMsg & vbCrLf & Err.Description
On Error GoTo 0
End Function

Public Function TransEmployeeRTC(iRst As ADODB.Recordset, oObject As Object) As Boolean
On Error GoTo ErrorHandler
TransEmployeeRTC = False

Dim Date_Init As Date

With oObject
.EmployeeID = IIf(IsNull(iRst("EmployeeID")), "", iRst("EmployeeID"))
.EmployeeName = IIf(IsNull(iRst("EmployeeName")), "", iRst("EmployeeName"))
.Gender = IIf(IsNull(iRst("Gender")), "", iRst("Gender"))
.DeptID = IIf(IsNull(iRst("DeptID")), "", iRst("DeptID"))
.Password = IIf(IsNull(iRst("Password")), "", iRst("Password"))
.PositionID = IIf(IsNull(iRst("PositionID")), "", iRst("PositionID"))
.UserGroup = IIf(IsNull(iRst("UserGroup")), "", iRst("UserGroup"))
.CalendarUniqueID = IIf(IsNull(iRst("CalendarUniqueID")), 0, iRst("CalendarUniqueID"))
.DefaultDeviceID = IIf(IsNull(iRst("DefaultDeviceID")), "", iRst("DefaultDeviceID"))
.EmployeeType = IIf(IsNull(iRst("EmployeeType")), 0, iRst("EmployeeType"))
.Literacy = IIf(IsNull(iRst("Literacy")), "", iRst("Literacy"))
.Birth = IIf(IsNull(iRst("Birth")), Date_Init, iRst("Birth"))
.WorkCenterID = IIf(IsNull(iRst("WorkCenterID")), "", iRst("WorkCenterID"))
.EmployeeEmail = IIf(IsNull(iRst("EmployeeEmail")), "", iRst("EmployeeEmail"))
.EmployeeSmsID = IIf(IsNull(iRst("EmployeeSmsID")), "", iRst("EmployeeSmsID"))
End With

RightExit:
TransEmployeeRTC = True
CleanExit:
Exit Function

ErrorHandler:
mStrMsg = "TransEmployeeRTC: 发生意外错误 " & mStrMsg & vbCrLf & Err.Description
On Error GoTo 0
End Function

Public Function TransEmployeeCTR(iObject As Object, oRst As ADODB.Recordset) As Boolean
On Error GoTo ErrorHandler
TransEmployeeCTR = False

With iObject
If .EmployeeID <> "" Then oRst("EmployeeID") = .EmployeeID
If .EmployeeName <> "" Then oRst("EmployeeName") = .EmployeeName
If .Gender <> "" Then oRst("Gender") = .Gender
If .DeptID <> "" Then oRst("DeptID") = .DeptID
If .Password <> "" Then oRst("Password") = .Password
If .PositionID <> "" Then oRst("PositionID") = .PositionID
If .UserGroup <> "" Then oRst("UserGroup") = .UserGroup
If .CalendarUniqueID <> "" Then oRst("CalendarUniqueID") = .CalendarUniqueID
If .DefaultDeviceID <> "" Then oRst("DefaultDeviceID") = .DefaultDeviceID
If .EmployeeType <> "" Then oRst("EmployeeType") = .EmployeeType
If .Literacy <> "" Then oRst("Literacy") = .Literacy
If .Birth <> "" Then oRst("Birth") = .Birth
If .WorkCenterID <> "" Then oRst("WorkCenterID") = .WorkCenterID
If .EmployeeEmail <> "" Then oRst("EmployeeEmail") = .EmployeeEmail
If .EmployeeSmsID <> "" Then oRst("EmployeeSmsID") = .EmployeeSmsID
End With

RightExit:
TransEmployeeCTR = True
CleanExit:
Exit Function

ErrorHandler:
mStrMsg = "TransEmployeeCTR: 发生意外错误 " & mStrMsg & vbCrLf & Err.Description
On Error GoTo 0
End Function

Public Function UpdateEmployee(iClsEmployee As CEmployee, Optional iRst As ADODB.Recordset) As Boolean
On Error GoTo ErrorHandler
UpdateEmployee = False

With iClsEmployee
If .DeleteFlag Then
If Not .IsNew Then DelEmployeeFromRst iClsEmployee
.DeleteFlag = False
.IsNew = False
.Dirty = False
Else
If .IsNew Then
AddEmployeeToRst iClsEmployee
.IsNew = False
.Dirty = False
Else
If .Dirty Then
UpdateEmployeeToRst iClsEmployee
.Dirty = False
End If
End If
End If
End With
RightExit:
UpdateEmployee = True
CleanExit:
Exit Function

ErrorHandler:
mStrMsg = "UpdateEmployee: 发生意外错误 " & mStrMsg & vbCrLf & Err.Description
On Error GoTo 0
End Function

Public Function UpdateEmployeeS(iColEmployeeS As CEmployeeS) As Boolean
On Error GoTo ErrorHandler
UpdateEmployeeS = False

mStrMsg = ""

Dim i As Integer
Dim rstUpdate As ADODB.Recordset
Dim cnTmp As New CMMCn
If iColEmployeeS.UpdateSQL = "" Then
mStrMsg = "UpdateEmployeeS:没有定义更新SQL语句，无法更新集合！"
GoTo CleanExit
End If

Set rstUpdate = New ADODB.Recordset
rstUpdate.Open iColEmployeeS.UpdateSQL, cnTmp.Connect, adOpenStatic, adLockBatchOptimistic
If Not iColEmployeeS.IsChange Then GoTo RightExit
Dim clsEmployee As CEmployee
'依次更新每一个对象
For i = 1 To iColEmployeeS.Count
If i > iColEmployeeS.Count Then Exit For
Set clsEmployee = iColEmployeeS(i)
'删除
If clsEmployee.DeleteFlag Then
If Not clsEmployee.IsNew Then
rstUpdate.Filter = " EmployeeID='" & clsEmployee.EmployeeID & "'"
rstUpdate.Delete
End If
iColEmployeeS.Remove i
i = i - 1
Else
If clsEmployee.IsNew Then
rstUpdate.AddNew
ElseIf clsEmployee.Dirty Then
rstUpdate.Filter = " EmployeeID='" & clsEmployee.EmployeeID & "'"
End If
If clsEmployee.IsNew Or clsEmployee.Dirty Then
rstUpdate("EmployeeID") = clsEmployee.EmployeeID
rstUpdate("EmployeeName") = clsEmployee.EmployeeName
rstUpdate("Gender") = clsEmployee.Gender
rstUpdate("DeptID") = clsEmployee.DeptID
rstUpdate("Password") = clsEmployee.Password
rstUpdate("PositionID") = clsEmployee.PositionID
rstUpdate("UserGroup") = clsEmployee.UserGroup
rstUpdate("CalendarUniqueID") = clsEmployee.CalendarUniqueID
rstUpdate("DefaultDeviceID") = clsEmployee.DefaultDeviceID
rstUpdate("EmployeeType") = clsEmployee.EmployeeType
rstUpdate("Literacy") = clsEmployee.Literacy
rstUpdate("Birth") = clsEmployee.Birth
rstUpdate("WorkCenterID") = clsEmployee.WorkCenterID
rstUpdate("EmployeeEmail") = clsEmployee.EmployeeEmail
rstUpdate("EmployeeSmsID") = clsEmployee.EmployeeSmsID
End If
End If

clsEmployee.DeleteFlag = False
clsEmployee.IsNew = False
clsEmployee.Dirty = False
Set clsEmployee = Nothing
Next
'更新数据到数据库
rstUpdate.UpdateBatch adAffectAllChapters
RightExit:
UpdateEmployeeS = True
CleanExit:
Set rstUpdate = Nothing
Set cnTmp = Nothing
Exit Function
ErrorHandler:
mStrMsg = "UpdateEmployeeS: 发生意外错误 " & mStrMsg & vbCrLf & Err.Description
End Function

Public Function AddEmployeeToRst(iClsEmployee As CEmployee, Optional iRst As ADODB.Recordset) As Boolean
On Error GoTo ErrorHandler
AddEmployeeToRst = False

Dim bIsRstFrom As Boolean
Dim rstTmp As New ADODB.Recordset
bIsRstFrom = True
If iRst Is Nothing Then bIsRstFrom = False

If Not bIsRstFrom Then
Dim cnTmp As New CMMCn
rstTmp.Open "Select * from Employee Where 1=2 ", cnTmp.Connect, adOpenDynamic, adLockBatchOptimistic
Else
Set rstTmp = iRst
End If

'公用部分
rstTmp.AddNew
If Not TransEmployeeCTR(iClsEmployee, rstTmp) Then
mStrMsg = "AddEmployeeToRst:" & mStrMsg
GoTo CleanExit
End If
rstTmp.Update
If Not bIsRstFrom Then
rstTmp.UpdateBatch
Set cnTmp = Nothing
End If

Set rstTmp = Nothing
RightExit:
AddEmployeeToRst = True
CleanExit:
Exit Function

ErrorHandler:
mStrMsg = "AddEmployeeToRst: 发生意外错误 " & mStrMsg & vbCrLf & Err.Description
On Error GoTo 0
End Function

Public Function UpdateEmployeeToRst(iClsEmployee As CEmployee, Optional iRst As ADODB.Recordset) As Boolean
On Error GoTo ErrorHandler
UpdateEmployeeToRst = False

Dim bIsRstFrom As Boolean
Dim rstTmp As ADODB.Recordset
bIsRstFrom = True
If iRst Is Nothing Then bIsRstFrom = False

If Not bIsRstFrom Then
Dim cnTmp As New CMMCn
Set rstTmp = New ADODB.Recordset
rstTmp.Open "Select * from Employee Where EmployeeID='" & iClsEmployee.EmployeeID & "'", cnTmp.Connect, adOpenDynamic, adLockBatchOptimistic
Else
Set rstTmp = iRst
rstTmp.Filter = " EmployeeID='" & iClsEmployee.EmployeeID & "'"
End If

'公用部分
If Not TransEmployeeCTR(iClsEmployee, rstTmp) Then
mStrMsg = "UpdateEmployeeToRst:" & mStrMsg
GoTo CleanExit
End If
rstTmp.Update
If Not bIsRstFrom Then
rstTmp.UpdateBatch
Set cnTmp = Nothing
End If

Set rstTmp = Nothing
RightExit:
UpdateEmployeeToRst = True
CleanExit:
Exit Function

ErrorHandler:
mStrMsg = "UpdateEmployeeToRst: 发生意外错误 " & mStrMsg & vbCrLf & Err.Description
On Error GoTo 0
End Function

Public Function DelEmployeeFromRst(iClsEmployee As CEmployee, Optional iRst As ADODB.Recordset) As Boolean
On Error GoTo ErrorHandler
DelEmployeeFromRst = False

Dim bIsRstFrom As Boolean
Dim rstTmp As ADODB.Recordset
bIsRstFrom = True
If iRst Is Nothing Then bIsRstFrom = False

If Not bIsRstFrom Then
Dim cnTmp As New CMMCn
cnTmp.Connect.Execute "Delete from Employee where EmployeeID='" & iClsEmployee.EmployeeID & "'"
Else
Set rstTmp = iRst
rstTmp.Filter = " EmployeeID='" & iClsEmployee.EmployeeID & "'"
rstTmp.Delete
rstTmp.Update
End If

If Not bIsRstFrom Then
Set cnTmp = Nothing
End If

Set rstTmp = Nothing
RightExit:
DelEmployeeFromRst = True
CleanExit:
Exit Function

ErrorHandler:
mStrMsg = "DelEmployeeFromRst: 发生意外错误 " & mStrMsg & vbCrLf & Err.Description
On Error GoTo 0
End Function

使用示例：

1 返回集合

Dim clsEmpEng As New CEmployeeEng '引擎类

'取得该类型的编码详细定义
Dim clsEmps As CEmployeeS '集合类 collection
'这里还要使用一部分SQL脚本，没办法，按照条件筛选，如果自己定义规则来解析执行，还不如用SQL
If Not clsEmpEng .GetEmployeeS(clsEmps , " EmployeeName like ''" & strCodeType & "' ") Then
mStrMsg = "取得编码规则时发生错误" & vbCrLf & clsCodeRuleEng.GetClsMsg
GoTo CleanExit
End If

2 新建、修改、删除

维护相应的flag

IsNew
Dirty
DeleteFlag

然后调用引擎类的相关更新函数，具体的大家可以自己捉摸，代码都在上面