fygsbms.cls

VB数据库设计的代码。需要根据自己的数据库再作调整

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "fygsbms"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"
Attribute VB_Ext_KEY = "Collection" ,"fygsbm"
Attribute VB_Ext_KEY = "Member0" ,"fygsbm"
Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
'局部变量，保存集合
Private mCol As Collection
'将一个“费用归属部门”对象加入集合
Public Sub Add(objfygsbm As fygsbm)
  mCol.Add objfygsbm, "A" & objfygsbm.xuhao
  '在加入对象时，最好同时加入其“KEY”属性
  '“KEY”属性不可以是数字型，因此在前面随便加
  '一个字母，此处加了一个“A”
End Sub

Public Property Get Item(vntIndexKey As Variant) As fygsbm
Attribute Item.VB_UserMemId = 0
    '引用集合中的一个元素时使用。
    'vntIndexKey 包含集合的索引或关键字，
    '这是为什么要声明为 Variant 的原因
    '语法：Set foo = x.Item(xyz) or Set foo = x.Item(5)
  Set Item = mCol(vntIndexKey)
End Property



Public Property Get Count() As Long
    '检索集合中的元素数时使用。语法：Debug.Print x.Count
    Count = mCol.Count
End Property


Public Sub Remove(vntIndexKey As Variant)
    '删除集合中的元素时使用。
    'vntIndexKey 包含索引或关键字，这是为什么要声明为 Variant 的原因
    '语法：x.Remove(xyz)


    mCol.Remove vntIndexKey
End Sub


Public Property Get NewEnum() As IUnknown
Attribute NewEnum.VB_UserMemId = -4
Attribute NewEnum.VB_MemberFlags = "40"
    '本属性允许用 For...Each 语法枚举该集合。
    Set NewEnum = mCol.[_NewEnum]
End Property


Private Sub Class_Initialize()
    '创建类后创建集合
    Set mCol = New Collection
End Sub


Private Sub Class_Terminate()
    '类终止后破坏集合
    Set mCol = Nothing
End Sub
'按条件查找费用归属部门，以集合类的方式返回
Public Function Find(Optional ByVal str As String = "") As fygsbms
  '定义用于存储sql语句的临时变量strSQL
  Dim strSQL As String
  '构造按条件查找费用归属部门的sql语句
  strSQL = "Select * from fygsbm"
  '如果传入的参数str不为空，则继续构造sql语句，其中采用“包含”的查询方法
  If str <> "" Then
    strSQL = strSQL & " where dm like '%" & RealString(str) & "%'"
    strSQL = strSQL & " or gsbmmc like '%" & RealString(str) & "%'"
  End If
  On Error Resume Next
  '定义用于存储查询结果的数据集对象rs
  Dim rs As Recordset
  '执行相应的SQL语句，并用得到的结果集设置数据集对象rs
  Set rs = Conn.Execute(strSQL)
  '判断是否找到符合条件的记录，如果没有找到，则给出错误提示
  If rs.RecordCount = 0 Then
     MsgBox "不存在符合条件的记录！"
     Set Find = Nothing
     Exit Function
  End If
  Dim i As Long
  '定义对应于单个费用归属部门的fygsbm类的对象
  Dim objfygsbm As fygsbm
  For i = Me.Count To 1 Step -1
     Me.Remove (i)
  Next i
  '将查找到的所有费用归属部门信息添加到集合类objfygsbms中
  For i = 1 To rs.RecordCount
   '创建一个新的fygsbm类对象
    Set objfygsbm = New fygsbm
    '根据当前的费用归属部门记录信息给新创建的objfygsbm对象的属性赋值
    With objfygsbm
      .xuhao = rs("xuhao").Value
      .dm = Trim(rs("dm").Value)
      .gsbmmc = Trim(rs("gsbmmc").Value)
    End With
    '在集合objfygsbms类中添加一个objfygsbm对象
    Me.Add objfygsbm
    '清空objfygsbm对象，用于记录下一个费用归属部门的信息
    Set objfygsbm = Nothing
    rs.MoveNext
  Next i
  '清空数据集对象rs
  Set rs = Nothing
  '设置该函数的返回值
  Set Find = Me
  Err.Clear
End Function