'FrmMain
Private tCBmdm As CBmdmPrivate Sub CmdAdd_Click()
    If CmdAdd.Caption = "增加(&A)" Then
        tCBmdm.Add
        TxtEmpty
        CmdDisenable
        CmdAdd.Caption = "取消(&C)"
    Else
        tCBmdm.CancelUpdate
        CmdEnable
        CmdLast_Click
        CmdAdd.Caption = "增加(&A)"
    End If
End SubPrivate Sub CmdFirst_Click()
    tCBmdm.MoveFirst
    ViewDate
End SubPrivate Sub CmdLast_Click()
    tCBmdm.MoveLast
    ViewDate
End SubPrivate Sub CmdModify_Click()
    tCBmdm.BMDM = TxtBmdm.Text
    tCBmdm.BMMC = TxtBmmc.Text
    tCBmdm.Save
End SubPrivate Sub CmdNext_Click()
    tCBmdm.MoveNext
    ViewDate
End SubPrivate Sub CmdPrev_Click()
    tCBmdm.MovePrev
    ViewDate
End SubPrivate Sub Form_Load()
    Set tCBmdm = New CBmdm
End SubPrivate Sub Form_Unload(Cancel As Integer)
    Set tCBmdm = Nothing
End Sub
Private Sub ViewDate()
    TxtBmdm.Text = tCBmdm.BMDM
    TxtBmmc.Text = tCBmdm.BMMC
End SubPrivate Sub TxtBmdm_Validate(Cancel As Boolean)
    On Error Resume Next
    tCBmdm.BMDM = TxtBmdm.Text
    If Err.Number <> 0 Then
        MsgBox Err.Description, vbInformation + vbOKOnly, App.Title
        Cancel = True
    End If
End SubPrivate Sub TxtBmmc_Validate(Cancel As Boolean)
    tCBmdm.BMMC = TxtBmmc.Text
End SubPrivate Sub TxtEmpty()
    TxtBmdm.Text = Empty
    TxtBmmc.Text = Empty
End SubPrivate Sub CmdDisenable()
    CmdFirst.Enabled = False
    CmdLast.Enabled = False
    CmdNext.Enabled = False
    CmdPrev.Enabled = False
End SubPrivate Sub CmdEnable()
    CmdFirst.Enabled = True
    CmdLast.Enabled = True
    CmdNext.Enabled = True
    CmdPrev.Enabled = True
End Sub类模块CBmdmOption Explicit
Private tBMDM As String
Private tBMMC As String
Private tCDataBmdm As CDataBmdm
Private tBC As BindingCollection
Public Enum CBmdmError
    cbmdmerrorbmdm = vbObjectError + 512 + 1
    CBmdmErrorBMMC = vbObjectError + 512 + 2
End EnumPrivate Sub Class_Initialize()
    Set tCDataBmdm = New CDataBmdm
    Set tBC = New BindingCollection
    With tBC
        Set .DataSource = tCDataBmdm
        .DataMember = "BMDMB"
        .Add Me, "BMDM", "BMDM"
        .Add Me, "BMMC", "BMMC"
    End With
End SubPrivate Sub Class_Terminate()
    Set tCDataBmdm = Nothing
    Set tBC = Nothing
End SubPublic Property Get BMDM() As String
    BMDM = tBMDM
End PropertyPublic Property Let BMDM(ByVal StrBMDM As String)
    If StrBMDM <> Empty Then
        tBMDM = StrBMDM
    Else
        Err.Raise cbmdmerrorbmdm, "CBmdm", "部门代码不能为空!"
    End If
End PropertyPublic Property Get BMMC() As String
    BMMC = tBMMC
End PropertyPublic Property Let BMMC(ByVal StrBMMC As String)
    tBMMC = StrBMMC
End PropertyPublic Sub MoveFirst()
    tCDataBmdm.MoveFirst
End SubPublic Sub MoveLast()
    tCDataBmdm.MoveLast
End SubPublic Sub MovePrev()
    tCDataBmdm.MovePrev
End SubPublic Sub MoveNext()
    tCDataBmdm.MoveNext
End SubPublic Sub Add()
    tCDataBmdm.Add
End SubPublic Sub Del()
    tCDataBmdm.Del
End SubPublic Sub CancelUpdate()
    tCDataBmdm.CancelUpdate
End SubPublic Sub Save()
    tCDataBmdm.Save
End Sub
'类模块CDataBmdmPrivate Con As ADODB.Connection
Private Rs As ADODB.Recordset
Public Enum CDataBmdmError
    CDataBmdmErrorAdd = vbObjectError + 512 + 1
    CDataBmdmErrorSave = vbObjectError + 512 + 2
    CDataBmdmErrorDel = vbObjectError + 512 + 3
    CDataBmdmErrorCancelUpdate = vbObjectError + 512 + 4
    CDataBmdmErrorCon = vbObjectError + 512 + 5
End EnumPrivate Sub Class_GetDataMember(DataMember As String, Data As Object)
    Select Case DataMember
        Case "BMDMB"
            Set Data = Rs
    End Select
End SubPrivate Sub Class_Initialize()
On Error GoTo HandleError
    Set Con = New ADODB.Connection
    Set Rs = New ADODB.Recordset
    With Con
        .ConnectionString = "Provider=SQLOLEDB.1;Password=iambeer;Persist Security Info=True;User ID=sa;Initial Catalog=XSSF"
        .ConnectionTimeout = 15
        .Open
    End With
    With Rs
        .CursorLocation = adUseClient
        .Open "Select bmdm,bmmc from bmdmb", Con, adOpenDynamic, adLockOptimistic, adCmdText
    End With
    With DataMembers
        .Add "BMDMB"
    End With
Exit Sub
HandleError:
    Err.Raise CDataBmdmErrorCon, "CDataBmdm", Err.Description
End SubPrivate Sub Class_Terminate()
    Set Con = Nothing
    Set Rs = Nothing
End SubPublic Sub Add()
On Error GoTo HandleError:
    Rs.AddNew
Exit Sub
HandleError:
    Err.Raise CDataBmdmErrorAdd, "CDataBmdm", "添加部门信息失败!"
End SubPublic Sub Del()
On Error GoTo HandleError:
    Rs.Delete
    Rs.MoveNext
    If Rs.EOF Then
        Rs.MovePrevious
        If Rs.BOF Then
            On Error GoTo 0
            Err.Raise CDataBmdmErrorDel, "CDataBmdm", "部门信已全部删除!"
        End If
    End If
Exit Sub
HandleError:
    Err.Raise CDataBmdmErrorDel, "CDataBmdm", "删除部门信息失败!"
End SubPublic Sub CancelUpdate()
On Error GoTo HandleError
    Rs.CancelUpdate
    Rs.MoveFirst
Exit Sub
HandleError:
    Err.Raise CDataBmdmErrorCancelUpdate, "CDataBmdm", "取消更新失败!"
End SubPublic Sub MoveFirst()
On Error Resume Next
    Rs.MoveFirst
End SubPublic Sub MoveLast()
On Error Resume Next
    Rs.MoveLast
End SubPublic Sub MovePrev()
On Error Resume Next
    Rs.MovePrevious
    If Rs.BOF Then
        Rs.MoveFirst
    End If
End SubPublic Sub MoveNext()
On Error Resume Next
    Rs.MoveNext
    If Rs.EOF Then
        Rs.MoveLast
    End If
End Sub
Public Sub Save()
On Error GoTo HandleError
    Rs.Update
Exit Sub
HandleError:
    Err.Raise CDataBmdmErrorCancelUpdate, "CDataBmdm", "更新失败!"
End Sub