frmcustomerinfo.frm

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

         Caption         =   "邮编"
         Height          =   255
         Left            =   600
         TabIndex        =   42
         Top             =   1665
         Width           =   495
      End
      Begin VB.Label Label9 
         Alignment       =   1  'Right Justify
         Caption         =   "详细地址"
         Height          =   255
         Left            =   240
         TabIndex        =   41
         Top             =   2100
         Width           =   855
      End
      Begin VB.Label Label10 
         Alignment       =   1  'Right Justify
         Caption         =   "电话"
         Height          =   255
         Left            =   240
         TabIndex        =   40
         Top             =   2520
         Width           =   855
      End
      Begin VB.Label Label11 
         Alignment       =   1  'Right Justify
         Caption         =   "传真"
         Height          =   255
         Left            =   2880
         TabIndex        =   39
         Top             =   2520
         Width           =   855
      End
      Begin VB.Label Label12 
         Alignment       =   1  'Right Justify
         Caption         =   "电子邮件"
         Height          =   255
         Left            =   5400
         TabIndex        =   38
         Top             =   420
         Width           =   855
      End
      Begin VB.Label Label13 
         Alignment       =   1  'Right Justify
         Caption         =   "主页"
         Height          =   255
         Left            =   5400
         TabIndex        =   37
         Top             =   840
         Width           =   855
      End
      Begin VB.Label Label14 
         Alignment       =   1  'Right Justify
         Caption         =   "年收入"
         Height          =   255
         Left            =   5400
         TabIndex        =   36
         Top             =   1260
         Width           =   855
      End
      Begin VB.Label Label15 
         Alignment       =   1  'Right Justify
         Caption         =   "员工数"
         Height          =   255
         Left            =   7920
         TabIndex        =   35
         Top             =   1260
         Width           =   615
      End
      Begin VB.Label Label16 
         Alignment       =   1  'Right Justify
         Caption         =   "行业"
         Height          =   255
         Left            =   5400
         TabIndex        =   34
         Top             =   1680
         Width           =   855
      End
      Begin VB.Label Label17 
         Alignment       =   1  'Right Justify
         Caption         =   "客户类型"
         Height          =   255
         Left            =   7800
         TabIndex        =   33
         Top             =   1680
         Width           =   735
      End
      Begin VB.Label Label18 
         Alignment       =   1  'Right Justify
         Caption         =   "客户来源"
         Height          =   255
         Left            =   5400
         TabIndex        =   32
         Top             =   2100
         Width           =   855
      End
      Begin VB.Label Label19 
         Alignment       =   1  'Right Justify
         Caption         =   "客户状态"
         Height          =   255
         Left            =   5400
         TabIndex        =   31
         Top             =   2520
         Width           =   855
      End
      Begin VB.Label lblCityCode 
         BorderStyle     =   1  'Fixed Single
         Height          =   315
         Left            =   3780
         TabIndex        =   30
         Top             =   1605
         Width           =   1455
      End
      Begin VB.Label lblNationCode 
         BorderStyle     =   1  'Fixed Single
         Height          =   315
         Left            =   3780
         TabIndex        =   29
         Top             =   780
         Width           =   1455
      End
      Begin VB.Label Label1 
         Alignment       =   1  'Right Justify
         Caption         =   "客户名称"
         Height          =   255
         Left            =   240
         TabIndex        =   28
         Top             =   420
         Width           =   855
      End
   End
End
Attribute VB_Name = "frmCustomerInfo"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
    Private blCombo_NationName As Boolean   'False：不要激活Combo_NationName_Click
    Private blCombo_ProvName As Boolean      'False：不要激活Combo_ProvName_Click
    Private blCombo_City As Boolean      'False：不要激活Combo_City_Click
    
Private Sub cmdActive_Click()
    frmActive.Show  '显示客户活动记录窗体
End Sub

Private Sub cmdAdd_Click()
    Dim Rst As New ADODB.Recordset          '临时记录集
    Dim Rst2 As New ADODB.Recordset         '第二个临时记录集，用于查找Area_ID
    Dim strSQL As String    '记录执行的SQL语句
    Dim intRst As Integer   '记录集中的记录条数
    
On Error GoTo ErrorExit
    If CheckFaceIsOk = False Then   '引用函数判断是否可以进行添加信息
        Exit Sub
    End If
    strSQL = "SELECT * FROM tb_Customer WHERE CustID ='C" & Me.txtCustID.Text & "'"
    Rst.Open strSQL, CnnDatabase, adOpenDynamic, adLockOptimistic   '打开一个动态记录集
    intRst = 0
    Do While Rst.EOF = False    '计算记录数
        intRst = intRst + 1
        Rst.MoveNext
    Loop
    If intRst > 0 Then          '在数据库中查找这个客户代号，看是不是已经有了
        If intRst > 1 Then      '数据库中已经有了，且不只一个
            MsgBox "这个客户代码已经在数据库中，且不唯一！", vbCritical, "数据库错误-"
        Else                    '数据库中有了一个。
            MsgBox "这个客户代码已经在数据库中。", vbCritical, Me.Caption
        End If
        Me.txtCustID.Text = ""
        Me.txtCustID.SetFocus
        Exit Sub
    End If
    Rst.AddNew                  '数据库中没有这个供应商代号，可以向里面新添了
    Rst.Fields("CustName").Value = Me.txtCustName.Text
    Rst.Fields("CustID").Value = "C" & Me.txtCustID.Text
        strSQL = "select Area_ID from tb_Area where NationName ='" & Me.Combo_NationName.Text & _
            "' AND ProvName ='" & Me.Combo_ProvName.Text & "' and CityName ='" & Me.Combo_City.Text & "'"
        Rst2.Open strSQL, CnnDatabase, adOpenStatic '静态打开第二个数据集
        If Rst2.RecordCount <> 1 Then   '得到的记录集中不只一条记录
            MsgBox "数据库中根据国家、省、城市得到的区域编号不唯一！", vbCritical, "数据库错误！"
            Rst2.Close
            Exit Sub
        End If
    Rst.Fields("Cust_Area_ID").Value = Rst2.Fields("Area_ID").Value
        Rst2.Close
    Rst.Fields("ZipCode").Value = Me.txtZipCode.Text
    Rst.Fields("Address").Value = Me.txtAddress.Text
    If Me.txtCustTel.Text <> "" Then
        Rst.Fields("CustTel").Value = Me.txtCustTel.Text
    End If
    If Me.txtCustFax.Text <> "" Then
        Rst.Fields("CustFax").Value = Me.txtCustFax.Text
    End If
    Rst.Fields("Email").Value = Me.txtEmail.Text
    Rst.Fields("WebSite").Value = Me.txtWebSite.Text
    If Me.txtIncoming.Text <> "" Then
        Rst.Fields("Incoming").Value = Me.txtIncoming.Text
    End If
    If Me.txtPeopleNum.Text <> "" Then
        Rst.Fields("PeopleNum").Value = Me.txtPeopleNum.Text
    End If
    Rst.Fields("Business").Value = Me.Combo_Business.Text
    Rst.Fields("CustType").Value = Me.Combo_CustType.Text
    Rst.Fields("CustFrom").Value = Me.Combo_CustFrom.Text
    Rst.Fields("CustState").Value = Me.Combo_CustState.Text
    Rst.Fields("ViaPerson").Value = Me.txtViaperson.Text
    If Me.txtViaTel.Text <> "" Then
        Rst.Fields("ViaTel").Value = Me.txtViaTel.Text
    End If
    If Me.txtViaFax.Text <> "" Then
        Rst.Fields("ViaFax").Value = Me.txtViaFax.Text
    End If
    Rst.Fields("JurPerson").Value = Me.txtJurperson.Text
    If Me.txtJurTel.Text <> "" Then
        Rst.Fields("JurTel").Value = Me.txtJurTel.Text
    End If
    If Me.txtJurFax.Text <> "" Then
        Rst.Fields("JurFax").Value = Me.txtJurFax.Text
    End If
    Rst.Update              '添加新信息结束
    MsgBox "添加新的供应商的信息成功！", vbInformation, "操作成功-"
    Set Rst = Nothing
    Initial_Add             '刷新界面
    Exit Sub
    
ErrorExit:
    MsgBox Err.Description, vbCritical, Me.Caption
End Sub

Private Sub cmdChange_Click()
    Dim Rst As New ADODB.Recordset          '临时记录集
    Dim Rst2 As New ADODB.Recordset         '第二个临时记录集，用于查找Area_ID
    Dim strSQL As String    '记录执行的SQL语句
    Dim intRst As Integer   '记录集中的记录条数
    
On Error GoTo ErrorExit
    If CheckFaceIsOk = False Then   '引用函数判断是否可以进行添加信息
        Exit Sub
    End If
    strSQL = "SELECT * FROM tb_Customer WHERE CustID ='C" & Me.txtCustID.Text & "'"
    Rst.Open strSQL, CnnDatabase, adOpenDynamic, adLockOptimistic   '打开一个动态记录集
    intRst = 0
    Do While Rst.EOF = False    '计算记录数
        intRst = intRst + 1
        Rst.MoveNext
    Loop
    If intRst <> 1 Then          '在数据库中查找这个客户代号，看是不是只有一个
        If intRst > 1 Then      '数据库中已经有了，但不只一个
            MsgBox "这个客户代码在数据库中不唯一！", vbCritical, "数据库错误-"
        Else                    '数据库中没有。
            MsgBox "这个客户代码不在数据库中。", vbCritical, Me.Caption
        End If
        Exit Sub
    End If
    Rst.MoveFirst               '回到第一条记录（即只此一条记录），准备更新记录
    Rst.Fields("CustName").Value = Me.txtCustName.Text '数据库中只有一个客户代号，可以开始更新了
    Rst.Fields("CustID").Value = "C" & Me.txtCustID.Text
        strSQL = "select Area_ID from tb_Area where NationName ='" & Me.Combo_NationName.Text & _
            "' AND ProvName ='" & Me.Combo_ProvName.Text & "' and CityName ='" & Me.Combo_City.Text & "'"
        Rst2.Open strSQL, CnnDatabase, adOpenStatic  '静态打开第二个数据集
        If Rst2.RecordCount <> 1 Then   '得到的记录集中不只一条记录
            MsgBox "数据库中根据国家、省、城市得到的区域编号不唯一！", vbCritical, "数据库错误！"
            Rst2.Close
            Exit Sub
        End If
    Rst.Fields("Cust_Area_ID").Value = Rst2!Area_ID
        Rst2.Close
    
    Rst.Fields("ZipCode").Value = Me.txtZipCode.Text
    Rst.Fields("Address").Value = Me.txtAddress.Text
    Rst.Fields("CustTel").Value = Me.txtCustTel.Text
    Rst.Fields("CustFax").Value = Me.txtCustFax.Text
    Rst.Fields("Email").Value = Me.txtEmail.Text
    Rst.Fields("WebSite").Value = Me.txtWebSite.Text
    Rst.Fields("Incoming").Value = Me.txtIncoming.Text
    Rst.Fields("PeopleNum").Value = Me.txtPeopleNum.Text
    Rst.Fields("Business").Value = Me.Combo_Business.Text
    Rst.Fields("CustType").Value = Me.Combo_CustType.Text
    Rst.Fields("CustFrom").Value = Me.Combo_CustFrom.Text
    Rst.Fields("CustState").Value = Me.Combo_CustState.Text
    Rst.Fields("ViaPerson").Value = Me.txtViaperson.Text
    Rst.Fields("ViaTel").Value = Me.txtViaTel.Text
    Rst.Fields("ViaFax").Value = Me.txtViaFax.Text
    Rst.Fields("JurPerson").Value = Me.txtJurperson.Text
    Rst.Fields("JurTel").Value = Me.txtJurTel.Text
    Rst.Fields("JurFax").Value = Me.txtJurFax.Text
    Rst.Update              '更新信息结束
    MsgBox "此客户信息修改成功！", vbInformation, "操作成功-"
    Set Rst = Nothing
    Initial_Change             '刷新界面
    Exit Sub
    
ErrorExit:
    MsgBox Err.Description, vbCritical, Me.Caption
End Sub

Private Sub cmdExit_Click()
    Unload Me
End Sub

Private Sub cmdFresh_Click()
    If flagAddCustomer = True Then      '添加新客户时的初始化
        Initial_Add
    Else
        Initial_Change      '修改客户时的初始化
    End If
End Sub

Private Sub Combo_City_Click()
    Dim Rst As New ADODB.Recordset
    Dim strSQL As String
    
    If blCombo_City = False Then
        Exit Sub
    End If
    strSQL = "select CityCode from tb_Area where NationName ='" & Me.Combo_NationName.Text & _
        "' AND ProvName ='" & Me.Combo_ProvName.Text & "' and CityName ='" & Me.Combo_City.Text & "'"
    Rst.Open strSQL, CnnDatabase, adOpenStatic  '静态打开一个记录集
    If Rst.RecordCount <> 1 Then                '如果找到的数据不唯一
        MsgBox "按国家/地区名称查到的区码不只一条！", vbCritical, "数据库错误-"
        Exit Sub
    End If
    Me.lblCityCode.Caption = Rst!CityCode   '显示城市区码
    Rst.Close
End Sub

Private Sub Combo_NationName_Click()
    Dim Rst As New ADODB.Recordset
    Dim strSQL As String
    
    If blCombo_NationName = False Then
        Exit Sub
    End If
    strSQL = "select NationCode from tb_NationCode where NationName='" & Me.Combo_NationName.Text & "'"
    Rst.Open strSQL, CnnDatabase, adOpenStatic  '静态打开一个记录集
    If Rst.RecordCount <> 1 Then                '如果找到的数据不唯一
        MsgBox "按国家/地区名称查到的区码不只一条！", vbCritical, "数据库错误-"
        Exit Sub
    End If
    Me.lblNationCode.Caption = Rst!NationCode   '显示国家区码
    Rst.Close
    strSQL = "select distinct ProvName from tb_Area where NationName='" & Me.Combo_NationName.Text & "'"
    Rst.Open strSQL, CnnDatabase, adOpenDynamic '动态打开记录集
    If Rst.BOF = True And Rst.EOF = True Then   '记录集为空
        MsgBox "此国家/地区中的省份未登录数据库中！", vbCritical, Me.Caption
        Exit Sub
    End If
    Me.Combo_ProvName.Enabled = True            '使控件可用
    Me.Combo_ProvName.Clear                     '先清空控件
    Do While Rst.EOF = False
        Me.Combo_ProvName.AddItem Rst!ProvName  '向combo控件中添加项目
        Rst.MoveNext
    Loop
    Rst.Close
End Sub

Private Sub Combo_ProvName_Click()
    Dim Rst As New ADODB.Recordset
    Dim strSQL As String
    
    If blCombo_ProvName = False Then
        Exit Sub
    End If
    strSQL = "select CityName from tb_Area where NationName ='" & Me.Combo_NationName.Text & _
        "' AND ProvName ='" & Me.Combo_ProvName.Text & "'"
    Rst.Open strSQL, CnnDatabase, adOpenDynamic '打开静态记录集
    If Rst.BOF = True And Rst.EOF = True Then   '记录集为空
        MsgBox "此国家/地区的省份中的城市未登录数据库中！", vbCritical, Me.Caption
        Exit Sub
    End If
    Me.Combo_City.Enabled = True                '使combo控件可用
    Me.Combo_City.Clear                         '先清空控件内
    Do While Rst.EOF = False
        Me.Combo_City.AddItem Rst!CityName      '向combo控件中添加项目
        Rst.MoveNext