OrFlying VB6版产生的代码示例_vb6 autocompleteflags-CSDN博客

本文链接：https://blog.csdn.net/arfayr/article/details/646063

鉴于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

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