frmcustomerinfo.frm

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

    Loop
    Rst.Close
End Sub

Private Sub Form_Load()
On Error GoTo ErrorExit
    Me.Height = 5795                '设置窗体外观
    Me.Width = 10215
    blCombo_NationName = False
    blCombo_ProvName = False
    blCombo_City = False
    If flagAddCustomer = True Then
        Me.Caption = "客户信息 — [添加]"     '此窗体标题栏设置
        Me.cmdAdd.Enabled = True                '按钮设置
        Me.cmdChange.Enabled = False
        Me.cmdAdd.Default = True
        Initial_Add                             '初始化界面
    Else
        Me.Caption = "客户信息 — [修改]"     '此窗体标题栏设置
        Me.cmdChange.Enabled = True             '按钮设置
        Me.cmdAdd.Enabled = False
        Me.Combo_City.Enabled = True
        Me.txtCustID.Text = Right(Module1.strCustID, 8)
        Me.txtCustID.Enabled = False            '使txtCustID控件不可用
        Me.txtCustID.BackColor = &H8000000F
        Initial_Change                          '初始化“修改”状态的窗体
    End If
    blCombo_NationName = True
    blCombo_ProvName = True
    Exit Sub
    
ErrorExit:
    MsgBox Err.Description, vbCritical, Me.Caption
End Sub

Private Sub Initial_Add()   '添加新客户信息的初始化程序
    Dim Rst As New ADODB.Recordset
    Dim strSQL As String
    
    With Combo_Business    '添加项目行业
        .Clear
        .AddItem "计算机业"
        .AddItem "建筑业"
        .AddItem "金融业"
        .AddItem "轻工业"
        .AddItem "重工业"
    End With
    With Combo_CustType    '添加项目客户类型
        .Clear
        .AddItem "正式客户"
        .AddItem "试用客户"
        .AddItem "潜在客户"
        .AddItem "竞争对手"
        .AddItem "代理商"
        .AddItem "内部员工"
    End With
    With Combo_CustFrom    '添加项目客户来源
        .Clear
        .AddItem "展览会"
        .AddItem "媒体广告"
        .AddItem "网络广告"
        .AddItem "朋友介绍"
        .AddItem "上门推销"
        .AddItem "主动上门"
    End With
    With Combo_CustState    '添加项目客户状态
        .Clear
        .AddItem "活跃"
        .AddItem "停顿"
        .AddItem "流失"
        .AddItem "发展中"
    End With
    strSQL = "select NationName from tb_NationCode order by NationName ASC"
    Rst.Open strSQL, CnnDatabase, adOpenDynamic, adLockReadOnly
    If Rst.BOF = True And Rst.EOF = True Then
        MsgBox "数据库中无任何国家/地区！", vbCritical, "数据库错误！"
        Exit Sub
    End If
    Combo_NationName.Clear
    Do While Rst.EOF = False    '给国家/地区添加项目
        Combo_NationName.AddItem Rst.Fields("NationName").Value
        Rst.MoveNext
    Loop
    Me.txtCustName.Text = ""    '清理控件内容
    Me.txtCustID.Text = ""
    Me.txtEmail.Text = ""
    Me.Combo_NationName.ListIndex = -1
    Me.lblNationCode.Caption = ""
    Me.txtWebSite.Text = ""
    Me.Combo_ProvName.Enabled = False   '省份栏清空禁用
    Me.Combo_ProvName.Clear
    Me.Combo_City.Enabled = False       '城市栏清空禁用
    Me.Combo_City.Clear
    Me.txtIncoming.Text = ""
    Me.txtPeopleNum.Text = ""
    Me.txtZipCode.Text = ""
    Me.lblCityCode.Caption = ""
    Me.Combo_Business.ListIndex = -1
    Me.Combo_CustType.ListIndex = -1
    Me.txtAddress.Text = ""
    Me.Combo_CustFrom.ListIndex = -1
    Me.txtCustTel.Text = ""
    Me.txtCustFax.Text = ""
    Me.Combo_CustState.ListIndex = -1
    Me.txtViaperson.Text = ""
    Me.txtViaTel.Text = ""
    Me.txtViaFax.Text = ""
    Me.txtJurperson.Text = ""
    Me.txtJurTel.Text = ""
    Me.txtJurFax.Text = ""
End Sub

Private Sub Initial_Change()    '更改客户信息的初始化程序
    Dim Rst As New ADODB.Recordset
    Dim Rst2 As New ADODB.Recordset '用于打开第二个临时记录集
    Dim Rst3 As New ADODB.Recordset '用于打开第三个临时记录集
    Dim strSQL As String
    Dim inti As Integer             '用于for循环
    
    With Combo_Business    '添加项目行业
        .Clear
        .AddItem "计算机业"
        .AddItem "建筑业"
        .AddItem "金融业"
        .AddItem "轻工业"
        .AddItem "重工业"
    End With
    With Combo_CustType    '添加项目客户类型
        .Clear
        .AddItem "正式客户"
        .AddItem "试用客户"
        .AddItem "潜在客户"
        .AddItem "竞争对手"
        .AddItem "代理商"
        .AddItem "内部员工"
    End With
    With Combo_CustFrom    '添加项目客户来源
        .Clear
        .AddItem "展览会"
        .AddItem "媒体广告"
        .AddItem "网络广告"
        .AddItem "朋友介绍"
        .AddItem "上门推销"
        .AddItem "主动上门"
    End With
    With Combo_CustState    '添加项目客户状态
        .Clear
        .AddItem "活跃"
        .AddItem "停顿"
        .AddItem "流失"
        .AddItem "发展中"
    End With
    strSQL = "select NationName from tb_NationCode order by NationName ASC"
    Rst.Open strSQL, CnnDatabase, adOpenDynamic, adLockReadOnly
    If Rst.BOF = True And Rst.EOF = True Then
        MsgBox "数据库中无任何国家/地区！", vbCritical, "数据库错误！"
        Exit Sub
    End If
    Combo_NationName.Clear
    Do While Rst.EOF = False    '给国家/地区添加项目
        Combo_NationName.AddItem Rst.Fields("NationName").Value
        Rst.MoveNext
    Loop
    Set Rst = Nothing
    
    strSQL = "select * from tb_Customer where CustID ='" & Module1.strCustID & "'"
    Rst.Open strSQL, CnnDatabase, adOpenDynamic, adLockReadOnly
    Me.txtCustName.Text = Rst!CustName    '给控件内容赋值
    Me.txtEmail.Text = Rst!Email
    
    strSQL = "select * from tb_Area where Area_ID =" & Rst!Cust_Area_ID & ""
    Rst2.Open strSQL, CnnDatabase, adOpenStatic  '静态打开记录集
    If Rst2.RecordCount <> 1 Then
        MsgBox "此客户在数据库中的地域（国家、省、市）对应的记录不唯一！", vbCritical, Me.Caption
        Exit Sub
    End If
    Me.Combo_NationName.Text = Rst2!NationName  '给国家名赋值
    
    strSQL = "select distinct ProvName from tb_Area where NationName ='" & Rst2!NationName & "'"
    Rst3.Open strSQL, CnnDatabase, adOpenDynamic
    If Rst3.BOF = True And Rst3.EOF = True Then   '记录集为空
        MsgBox "数据库中没有记载任何此国家/地区中的省份！", vbCritical, Me.Caption
        Exit Sub
    End If
    Me.Combo_ProvName.Enabled = True            '使省份栏可用
    Me.Combo_ProvName.Clear                     '先清空控件
    Do While Rst3.EOF = False
        Me.Combo_ProvName.AddItem Rst3!ProvName  '向省份的combo控件中添加项目
        Rst3.MoveNext
    Loop
    Rst3.Close
    Me.Combo_ProvName.Text = Rst2!ProvName  '给省名赋值
    
    strSQL = "select CityName from tb_Area where NationName ='" & Rst2!NationName & "' and ProvName ='" & Rst2!ProvName & "'"
    Rst3.Open strSQL, CnnDatabase, adOpenDynamic
    If Rst3.BOF = True And Rst3.EOF = True Then   '记录集为空
        MsgBox "数据库中没有记载任何此省份中的城市！", vbCritical, Me.Caption
        Exit Sub
    End If
    Me.Combo_City.Enabled = True            '使城市栏可用
    Me.Combo_City.Clear                     '先清空控件
    Do While Rst3.EOF = False
        Me.Combo_City.AddItem Rst3!CityName  '向城市的combo控件中添加项目
        Rst3.MoveNext
    Loop
    Rst3.Close
    Me.Combo_City.Text = Rst2!CityName      '给城市名赋值
    
    strSQL = "select NationCode from tb_NationCode where NationName ='" & Me.Combo_NationName & "'"
    Rst3.Open strSQL, CnnDatabase, adOpenStatic
    If Rst3.RecordCount <> 1 Then
        MsgBox "有国家出现多区码重复！", vbCritical, "数据库错误-"
        Exit Sub
    End If
    Me.lblNationCode.Caption = Rst3!NationCode  '国家区码
    Rst3.Close
    
    Me.lblCityCode.Caption = Rst2!CityCode   '城市区号
    Rst2.Close                               'rst2临时记录集不需要了，关闭
    Me.txtWebSite.Text = Rst!Website
    Me.txtIncoming.Text = Rst!Incoming
    Me.txtPeopleNum.Text = Rst!PeopleNum
    Me.txtZipCode.Text = Rst!ZipCode
    For inti = 0 To Me.Combo_Business.ListCount - 1 '行业
        If Me.Combo_Business.List(inti) = Rst!Business Then
            Me.Combo_Business.ListIndex = inti
            Exit For
        End If
    Next
    For inti = 0 To Me.Combo_CustType.ListCount - 1 '客户类型
        If Me.Combo_CustType.List(inti) = Rst!CustType Then
            Me.Combo_CustType.ListIndex = inti
            Exit For
        End If
    Next
    Me.txtAddress.Text = Rst!Address
    For inti = 0 To Me.Combo_CustFrom.ListCount - 1 '客户来源
        If Me.Combo_CustFrom.List(inti) = Rst!CustFrom Then
            Me.Combo_CustFrom.ListIndex = inti
            Exit For
        End If
    Next
    Me.txtCustTel.Text = Rst!CustTel
    Me.txtCustFax.Text = Rst!CustFax
    For inti = 0 To Me.Combo_CustState.ListCount - 1 '客户状态
        If Me.Combo_CustState.List(inti) = Rst!CustState Then
            Me.Combo_CustState.ListIndex = inti
            Exit For
        End If
    Next
    Me.txtViaperson.Text = Rst!Viaperson
    Me.txtViaTel.Text = Rst!ViaTel
    Me.txtViaFax.Text = Rst!Viafax
    Me.txtJurperson.Text = Rst!Jurperson
    Me.txtJurTel.Text = Rst!JurTel
    Me.txtJurFax.Text = Rst!Jurfax
End Sub

'在添加或修改信息前判断界面是否正确，例如控件内容不为空，数字、位数是否正确等。
Private Function CheckFaceIsOk() As Boolean
    Dim intText As Integer  '记录textbox控件中每位字符所在第几位
    Dim strText As String   '指向textbox控件中的每一位字符
    
    CheckFaceIsOk = False   '初设默认不正确
    If Me.txtCustID = "" Then   '客户代码不得为空
        MsgBox "客户代码不得为空！", vbCritical, Me.Caption
        Me.txtCustID.SetFocus
        Exit Function
    End If
    For intText = 1 To Len(Me.txtCustID.Text)      '用数字填写txtCustID栏
        strText = Asc(Mid(Me.txtCustID.Text, intText, 1))
        If strText < 48 Or strText > 57 Then
            MsgBox "请用数字填写客户代码栏空白处内容！", vbCritical, Me.Caption
            Me.txtCustID.Text = ""
            Me.txtCustID.SetFocus
            Exit Function
        End If
    Next
    If Len(Me.txtCustID.Text) <> 8 Then     '必须用8位纯数字填写客户代码栏空白处
        MsgBox "要用8位纯数字填写客户代码栏的空白处！", vbCritical, "客户代码填写错误-"
        Me.txtCustID.Text = ""
        Me.txtCustID.SetFocus
        Exit Function
    End If
    If Me.Combo_NationName.Text = "" Then    '国家/地区不得为空
        MsgBox "国家/地区不得为空！", vbCritical, Me.Caption
        Exit Function
    End If
    If Me.Combo_ProvName.Text = "" Then    '省份栏不得为空
        MsgBox "省份不得为空！", vbCritical, Me.Caption
        Exit Function
    End If
    If Me.Combo_City.Text = "" Then    '城市栏不得为空
        MsgBox "城市不得为空！", vbCritical, Me.Caption
        Exit Function
    End If
    For intText = 1 To Len(Me.txtCustTel.Text)      '用数字填写电话栏
        strText = Asc(Mid(Me.txtCustTel.Text, intText, 1))
        If strText < 48 Or strText > 57 Then
            MsgBox "请用数字填写电话栏内容！", vbCritical, Me.Caption
            Me.txtCustTel.Text = ""
            Me.txtCustTel.SetFocus
            Exit Function
        End If
    Next
    For intText = 1 To Len(Me.txtCustFax.Text)      '用数字填写传真栏
        strText = Asc(Mid(Me.txtCustFax.Text, intText, 1))
        If strText < 48 Or strText > 57 Then
            MsgBox "请用数字填写传真栏内容！", vbCritical, Me.Caption
            Me.txtCustFax.Text = ""
            Me.txtCustFax.SetFocus
            Exit Function
        End If
    Next
    For intText = 1 To Len(Me.txtIncoming.Text)      '用数字填写年收入
        strText = Asc(Mid(Me.txtIncoming.Text, intText, 1))
        If strText < 48 Or strText > 57 Then
            MsgBox "请用数字填写年收入一栏内容！", vbCritical, Me.Caption
            Me.txtIncoming.Text = ""
            Me.txtIncoming.SetFocus
            Exit Function
        End If
    Next
    For intText = 1 To Len(Me.txtPeopleNum.Text)      '用数字填写员工数
        strText = Asc(Mid(Me.txtPeopleNum.Text, intText, 1))
        If strText < 48 Or strText > 57 Then
            MsgBox "请用数字填写员工数一栏内容！", vbCritical, Me.Caption
            Me.txtPeopleNum.Text = ""
            Me.txtPeopleNum.SetFocus
            Exit Function
        End If
    Next
    For intText = 1 To Len(Me.txtViaTel.Text)      '用数字填写联系人电话
        strText = Asc(Mid(Me.txtViaTel.Text, intText, 1))
        If strText < 48 Or strText > 57 Then
            MsgBox "请用数字填写联系人电话！", vbCritical, Me.Caption
            Me.txtViaTel.Text = ""
            Me.txtViaTel.SetFocus
            Exit Function
        End If
    Next
    For intText = 1 To Len(Me.txtViaFax.Text)      '用数字填写联系人传真
        strText = Asc(Mid(Me.txtViaFax.Text, intText, 1))
        If strText < 48 Or strText > 57 Then
            MsgBox "请用数字填写联系人传真！", vbCritical, Me.Caption
            Me.txtViaFax.Text = ""
            Me.txtViaFax.SetFocus
            Exit Function
        End If
    Next
    For intText = 1 To Len(Me.txtJurTel.Text)      '用数字填写法人电话
        strText = Asc(Mid(Me.txtJurTel.Text, intText, 1))
        If strText < 48 Or strText > 57 Then
            MsgBox "请用数字填写法人电话！", vbCritical, Me.Caption
            Me.txtJurTel.Text = ""
            Me.txtJurTel.SetFocus
            Exit Function
        End If
    Next
    For intText = 1 To Len(Me.txtJurFax.Text)      '用数字填写法人传真
        strText = Asc(Mid(Me.txtJurFax.Text, intText, 1))
        If strText < 48 Or strText > 57 Then
            MsgBox "请用数字填写法人传真！", vbCritical, Me.Caption
            Me.txtJurFax.Text = ""
            Me.txtJurFax.SetFocus
            Exit Function
        End If
    Next
    CheckFaceIsOk = True    '设置表示界面正确了！
    Exit Function
    
ErrorExit:
    MsgBox Err.Description, vbCritical, Me.Caption
End Function