fygsbm.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 = "fygsbm"
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 = "Top_Level" ,"Yes"
'保持属性值的局部变量
'定义用于存储费用归属部门代码的临时变量
Private mvardm As Variant
'定义用于存储费用归属部门名称的临时变量
Private mvargsbmmc As Variant
'保持属性值的局部变量
Private mvarxuhao As Integer '局部复制
Public Property Let xuhao(ByVal vData As Integer)
'向属性指派值时使用，位于赋值语句的左边。
'Syntax: X.xuhao = 5
    mvarxuhao = vData
End Property
Public Property Get xuhao() As Integer
'检索属性值时使用，位于赋值语句的右边。
'Syntax: Debug.Print X.xuhao
    xuhao = mvarxuhao
End Property
Public Property Let gsbmmc(ByVal vData As Variant)
'向属性指派值时使用，位于赋值语句的左边。
'Syntax: X.gsbmmc = 5
    mvargsbmmc = vData
End Property

'设置费用归属部门名称
Public Property Set gsbmmc(ByVal vData As Variant)
'向属性指派对象时使用，位于 Set 语句的左边。
'Syntax: Set x.gsbmmc = Form1
    Set mvargsbmmc = vData
End Property

'获得费用归属部门名称
Public Property Get gsbmmc() As Variant
'检索属性值时使用，位于赋值语句的右边。
'Syntax: Debug.Print X.gsbmmc
    If IsObject(mvargsbmmc) Then
        Set gsbmmc = mvargsbmmc
    Else
        gsbmmc = mvargsbmmc
    End If
End Property

Public Property Let dm(ByVal vData As Variant)
'向属性指派值时使用，位于赋值语句的左边。
'Syntax: X.dm = 5
    mvardm = vData
End Property

'设置费用归属部门代码
Public Property Set dm(ByVal vData As Variant)
'向属性指派对象时使用，位于 Set 语句的左边。
'Syntax: Set x.dm = Form1
    Set mvardm = vData
End Property

'获得费用归属部门代码
Public Property Get dm() As Variant
'检索属性值时使用，位于赋值语句的右边。
'Syntax: Debug.Print X.dm
    If IsObject(mvardm) Then
        Set dm = mvardm
    Else
        dm = mvardm
    End If
End Property
'添加一个费用归属部门的信息
Public Function AddNew(Optional ByVal strdm As String = "", _
                       Optional ByVal strgsbmmc As String = "") As fygsbmAddNew
  On Error Resume Next
  
  '如果参数为缺省值，即未传入，则直接调用类中的参数，否则调用传入的参数
  '判断输入的费用归属部门代码是否为空，如果为空，则给出错误提示；如果不为空，
  '则在该类的dm变量中存储部门代码
  If strdm = "" Then
    MsgBox "费用归属部门代码不能为空！"
    Exit Function
  Else
    Me.dm = strdm
  End If
  '判断输入的费用归属部门名称是否为空，如果为空，则给出错误提示；如果不为空，
  '则在该类的gsbmmc变量中存储部门名称
  If strgsbmmc = "" Then
    MsgBox "费用归属部门名称不能为空！"
    Exit Function
  Else
    Me.gsbmmc = strgsbmmc
  End If
  '检测输入的费用归属部门代码是否存在
  If ExistByName("fygsbm", "dm", strdm) Then
      AddNew = DuplicateDm_AddNew
      MsgBox "输入的费用归属部门代码已经存在！"
      Exit Function
  End If
  '检测输入的费用归属部门名称是否存在
  If ExistByName("fygsbm", "gsbmmc", strgsbmmc) Then
      AddNew = DuplicateGsbmmc_AddNew
      MsgBox "输入的费用归属部门名称已经存在！"
      Exit Function
  End If
  '定义存储sql语句的临时变量strSQL
  Dim strSQL As String
  '定义存储sql语句执行错误时显示的错误信息的临时变量ErrMsg
  Dim ErrMsg As String
  '构造SQL语句，注意需调用RealString去除字符串中的单引号
  strSQL = "Insert into fygsbm (dm,gsbmmc)"
  strSQL = strSQL & " VALUES("
  strSQL = strSQL & "'" & RealString(dm) & "','"
  strSQL = strSQL & RealString(gsbmmc)
  strSQL = strSQL & "')"
   MsgBox strSQL
  '执行sql语句，并根据执行的结果设置函数返回值
  If RunSql(strSQL, ErrMsg) Then
    AddNew = AddNewOK
  Else
    AddNew = AddNewFail
  End If
End Function
'修改一个费用归属部门的信息
Public Function Update(Optional ByVal strdm As String = "", _
                       Optional ByVal strgsbmmc As String = "") As fygsbmUpdate
  On Error Resume Next
  '判断输入的费用归属部门代码是否为空，如果为空，则给出错误提示；如果不为空，
  '则在该类的dm变量中存储部门代码
  If strdm = "" Then
    MsgBox "费用归属部门代码不能为空！"
    Exit Function
  End If
  '判断输入的费用归属部门名称是否为空，如果为空，则给出错误提示；如果不为空，
  '则在该类的gsbmmc变量中存储部门名称
  If strgsbmmc = "" Then
    MsgBox "费用归属部门名称不能为空！"
    Exit Function
  End If
  '检测输入的费用归属部门代码是否存在
  If strdm <> Me.dm Then
     If ExistByName("fygsbm", "dm", strdm) Then
         Update = DuplicateDm_Update
         MsgBox "输入的费用归属部门代码已经存在！"
         Exit Function
     Else
         Me.dm = strdm
     End If
  End If
  '检测输入的费用归属部门名称是否存在
  If strgsbmmc <> Me.gsbmmc Then
      If ExistByName("fygsbm", "gsbmmc", strgsbmmc) Then
         Update = DuplicateGsbmmc_Update
         MsgBox "输入的费用归属部门名称已经存在！"
         Exit Function
      Else
         Me.gsbmmc = strgsbmmc
      End If
  End If
  Dim strSQL As String
  '构造SQL语句
  strSQL = "Update fygsbm set "
  strSQL = strSQL & "dm= '" & RealString(Me.dm) & "',"
  strSQL = strSQL & "gsbmmc= '" & RealString(Me.gsbmmc) & "'"
  strSQL = strSQL & " Where xuhao=" & Me.xuhao
  MsgBox strSQL
  '执行SQL语句
  Conn.Execute strSQL
  '根据执行的结果设置函数返回值
  If Err.Number = 0 Then
    Update = UpdateOK
  Else
    Update = UpdateFail
  End If
  '如果发生错误，则返回FALSE，表示未成功更新
End Function
'删除一个费用归属部门的信息
Public Function Delete(Optional ByVal xuhao As Integer = 0) As fygsbmDelete
  Dim strSQL As String
  Dim m_xuhao As Integer
  If xuhao <> 0 Then
    m_xuhao = xuhao
  Else
    m_xuhao = Me.xuhao
  End If
  '判断数据表fygsbm中是否存在欲删除的费用归属部门
  If Not ExistByID("fygsbm", "xuhao", m_xuhao) Then
    '数据表fygsbm中不存在欲删除的费用归属部门,设置函数返回值
    Delete = DeleteNoExists
    MsgBox "要删除的费用归属部门信息不存在！"
    Exit Function
  End If
  On Error Resume Next
  '设置sql语句，用于删除fygsbm表中的相关部门信息
  strSQL = "DELETE FROM fygsbm WHERE xuhao =" & m_xuhao
  '执行SQL语句
  MsgBox m_xuhao
  MsgBox strSQL
  Conn.Execute strSQL
  '返回操作结果
  Delete = IIf(Err.Number = 0, DeleteOK, DeleteFail)
End Function