frmactive.frm

客户关系管理系统(打包+源程序)是数据库系统开发项目方案精解系列丛书VB数据库管理中附带CD中的程序

        Initial
        blAdd = True
        Me.cmdAdd.Caption = "保存"
        Me.cmdChange.Enabled = False
        Me.txtCustID.Enabled = True
        Me.txtCustID.BackColor = &H80000005
    Else                    '添加新记录
        Me.cmdAdd.Caption = "添加"
        Me.cmdChange.Enabled = True
        Me.txtCustID.Enabled = False
        Me.txtCustID.BackColor = &H80000013
        blAdd = False
        strSQL = "select * from tb_customer where custid='C" & Me.txtCustID & "'"
        Rst.Open strSQL, CnnDatabase, adOpenStatic
        If Rst.RecordCount <> 1 Then
            If Rst.RecordCount > 1 Then
                MsgBox "这个客户代码在数据库中不只一个！", vbCritical, "错误！"
            Else
                MsgBox "此客户代码不存在！"
            End If
            Exit Sub
        End If
        Rst.Close
        strSQL = "select * from tb_active "     '设置SQL语句
        strSQL = strSQL & " where CustID='C" & Me.txtCustID.Text & "'"
        strSQL = strSQL & " and SetDate=#" & Me.DT_SetDate.Value & "#"
        strSQL = strSQL & " and ChangeDate=#" & Me.DT_ChangeDate.Value & "#"
        strSQL = strSQL & " and teldate=#" & Me.DT_TelDate.Value & "#"
        strSQL = strSQL & " and meetdate=#" & Me.DT_MeetDate.Value & "#"
        strSQL = strSQL & " and buydate=#" & Me.DT_BuyDate.Value & "#"
        Rst.Open strSQL, CnnDatabase, adOpenStatic, adLockOptimistic
        If Rst.RecordCount > 0 Then    '数据库中已经有记录了
            MsgBox "已经有此记录，您可以对此记录进行修改操作！", vbExclamation, Me.Caption
            Exit Sub
        End If
        Rst.AddNew      '添加记录
        Rst!CustID = "C" & Me.txtCustID       '客户代码
        Rst!SetDate = Me.DT_SetDate     '记录创建日期
        Rst!ChangeDate = Me.DT_ChangeDate   '记录修改日期
        Rst!TelDate = Me.DT_TelDate     '电话日期
        Rst!MeetDate = Me.DT_MeetDate   '会见日期
        Rst!BuyDate = Me.DT_BuyDate     '购买日期
        If IsNull(Me.txtContent) = False Then
            Rst!Content = Me.txtContent     '磋商内容记录
        Else
            Rst!Content = ""
        End If
        Rst.Update
        MsgBox "添加成功！"
        Initial                         '初始化界面
    End If
End Sub

Private Sub cmdChange_Click()
    Dim Rst As New ADODB.Recordset
    Dim strSQL As String

    strSQL = "select * from tb_customer where custid='C" & Me.txtCustID & "'"
    Rst.Open strSQL, CnnDatabase, adOpenStatic
    If Rst.RecordCount <> 1 Then    '在数据库tb_customer中查找
        If Rst.RecordCount > 1 Then
            MsgBox "这个客户代码在数据库中不只一个！", vbCritical, "错误！"
        Else
            MsgBox "此客户代码不存在！"
        End If
        Exit Sub
    End If
    Rst.Close
    strSQL = "select * from tb_active "     '设置SQL语句
    strSQL = strSQL & " where CustID='C" & Me.txtCustID.Text & "'"
    strSQL = strSQL & " and SetDate=#" & Me.DT_SetDate.Value & "#"
    strSQL = strSQL & " and ChangeDate=#" & Me.DT_ChangeDate.Value & "#"
    strSQL = strSQL & " and teldate=#" & Me.DT_TelDate.Value & "#"
    strSQL = strSQL & " and meetdate=#" & Me.DT_MeetDate.Value & "#"
    strSQL = strSQL & " and buydate=#" & Me.DT_BuyDate.Value & "#"
    Rst.Open strSQL, CnnDatabase, adOpenStatic, adLockOptimistic
    If Rst.RecordCount <> 1 Then    '数据库中此记录不唯一
        If Rst.RecordCount > 1 Then
            MsgBox "此记录在数据库中有多个！", vbExclamation, Me.Caption
        Else
            MsgBox "数据库错误：无此记录？！"
        End If
        Exit Sub
    End If
    Rst!CustID = "C" & Me.txtCustID       '修改记录：客户代码
    Rst!SetDate = Me.DT_SetDate     '记录创建日期
    Rst!ChangeDate = Me.DT_ChangeDate   '记录修改日期
    Rst!TelDate = Me.DT_TelDate     '电话日期
    Rst!MeetDate = Me.DT_MeetDate   '会见日期
    Rst!BuyDate = Me.DT_BuyDate     '购买日期
    If IsNull(Me.txtContent) = False Then
        Rst!Content = Me.txtContent     '磋商内容记录
    Else
        Rst!Content = ""
    End If
    Rst.Update                      '修改结束
    MsgBox "修改成功！"
    Initial                         '重新初始化界面
End Sub

Private Sub cmdDel_Click()
    Dim Rst As New ADODB.Recordset
    Dim strSQL As String
    Dim varMSG      '记录Msgbox 的返回值
    Dim inti As Integer '用于for循环，记录当前MSFlex的行号
'    Dim intj As Integer '用于for循环，记录当前MSFlex的列号
    
    If Me.MSFlexGrid1.RowSel = 0 Then
        MsgBox "请先选择要删除的一条或多条记录"
        Exit Sub
    End If
    varMSG = MsgBox("确定要删除这些记录吗？此操作不可逆转！", vbYesNo)
    If varMSG = vbNo Then
        Exit Sub
    End If
    For inti = Me.MSFlexGrid1.Row To Me.MSFlexGrid1.RowSel
        strSQL = "select * from tb_active "     '设置SQL语句
        strSQL = strSQL & " where CustID='" & Me.MSFlexGrid1.TextMatrix(inti, 0) & "'"
        strSQL = strSQL & " and SetDate=#" & Me.MSFlexGrid1.TextMatrix(inti, 1) & "#"
        strSQL = strSQL & " and ChangeDate=#" & Me.MSFlexGrid1.TextMatrix(inti, 2) & "#"
        strSQL = strSQL & " and TelDate=#" & Me.MSFlexGrid1.TextMatrix(inti, 3) & "#"
        strSQL = strSQL & " and MeetDate=#" & Me.MSFlexGrid1.TextMatrix(inti, 4) & "#"
        strSQL = strSQL & " and BuyDate=#" & Me.MSFlexGrid1.TextMatrix(inti, 5) & "#"
        Rst.Open strSQL, CnnDatabase, adOpenStatic, adLockOptimistic
        If Rst.RecordCount <> 1 Then    '数据库中此记录不唯一
            If Rst.RecordCount > 1 Then
                MsgBox "有记录在数据库中有多个！", vbExclamation, Me.Caption
            Else
                MsgBox "数据库错误：缺少记录？！"
            End If
            Rst.Close
            Exit Sub
        End If
        Rst.Delete
    '    Rst.Update
        Rst.Close
    Next inti
    MsgBox "删除成功！"
    Initial                         '重新初始化界面
End Sub

Private Sub cmdExit_Click()
    blAdd = False
    Unload Me
End Sub

Private Sub Initial()
    Dim Rst As New ADODB.Recordset
    Dim strSQL As String
    Dim strMSF As String    'MSFlex控件添加的内容字符串
    
    Me.MSFlexGrid1.Rows = 1 'MSFlex初始化
    Me.txtCustID.Text = ""   '界面清空
    Me.txtContent = ""
    Me.DT_BuyDate.Value = Date
    Me.DT_ChangeDate.Value = Date
    Me.DT_MeetDate.Value = Date
    Me.DT_SetDate.Value = Date
    Me.DT_TelDate.Value = Date
    strSQL = "select * from tb_active"
    Rst.Open strSQL, CnnDatabase, adOpenDynamic, adLockReadOnly
    Do While Rst.EOF = False    'MSFlex添加行
    '^ 客户代码 |^ 记录创建日期 |^ 记录修改日期 |^ 电话日期 |^ 会面日期 |^ 购买日期
        strMSF = Rst!CustID & Chr(9) & Rst!SetDate & Chr(9) & Rst!ChangeDate & Chr(9) _
            & Rst!TelDate & Chr(9) & Rst!MeetDate & Chr(9) & Rst!BuyDate
        Me.MSFlexGrid1.AddItem strMSF
        Rst.MoveNext
    Loop
    Me.MSFlexGrid1.Row = 0
End Sub

Private Sub Form_Load()
    blAdd = False
    Initial
End Sub

Private Sub MSFlexGrid1_DblClick()
    Dim Rst As New ADODB.Recordset
    Dim strSQL As String
    
    Me.cmdAdd.Caption = "添加"
    Me.cmdChange.Enabled = True
    Me.txtCustID.Enabled = False
    Me.txtCustID.BackColor = &H80000013
    blAdd = False
    strSQL = "select * from tb_active "
    Me.MSFlexGrid1.Col = 0
    Me.txtCustID.Text = Mid(Me.MSFlexGrid1.Text, 2, Len(Me.MSFlexGrid1) - 1) '客户代码
    strSQL = strSQL & " where CustID='" & Me.MSFlexGrid1.Text & "'"
    Me.MSFlexGrid1.Col = 1
    Me.DT_SetDate = Me.MSFlexGrid1.Text         '记录创建日期
    strSQL = strSQL & " and SetDate=#" & Me.MSFlexGrid1.Text & "#"
    Me.MSFlexGrid1.Col = 2
    Me.DT_ChangeDate = Me.MSFlexGrid1.Text      '记录修改日期
    strSQL = strSQL & " and ChangeDate=#" & Me.MSFlexGrid1.Text & "#"
    Me.MSFlexGrid1.Col = 3
    Me.DT_TelDate = Me.MSFlexGrid1.Text         '电话日期
    strSQL = strSQL & " and teldate=#" & Me.MSFlexGrid1.Text & "#"
    Me.MSFlexGrid1.Col = 4
    Me.DT_MeetDate = Me.MSFlexGrid1.Text        '会见日期
    strSQL = strSQL & " and meetdate=#" & Me.MSFlexGrid1.Text & "#"
    Me.MSFlexGrid1.Col = 5
    Me.DT_BuyDate = Me.MSFlexGrid1.Text         '购买日期
    strSQL = strSQL & " and buydate=#" & Me.MSFlexGrid1.Text & "#"
    Rst.Open strSQL, CnnDatabase, adOpenStatic
    If Rst.RecordCount <> 1 Then
        MsgBox "有重复数据！", vbCritical, "数据库错误"
        Exit Sub
    End If
    If IsNull(Rst!Content) = False Then
        Me.txtContent = Rst!Content                 '磋商内容记录
    Else
        Me.txtContent = ""
    End If
End Sub