'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
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
说明白点儿大家才能帮你呀。