frmsupplierinfo.frm

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

    Me.DT_LimitStart.Value = Rst.Fields("LimitStart").Value
    Me.DT_LimitEnd.Value = Rst.Fields("LimitEnd").Value
    Me.txtPostcode.Text = Rst.Fields("Postcode").Value
    Me.txtEmail.Text = Rst.Fields("Email").Value
    Me.txtWebSite.Text = Rst.Fields("Website").Value
    Me.Combo_Type.Text = Rst.Fields("Type").Value
    Me.txtProperty.Text = Rst.Fields("Property").Value
    Me.txtRegeditfund.Text = Rst.Fields("Regeditfund").Value
    Me.txtRegeditMoney.Text = Rst.Fields("RegeditMoney").Value
    Me.txtRegeditcode.Text = Rst.Fields("Regeditcode").Value
    Me.Combo_Supplevel.Text = Rst.Fields("Supplevel").Value
    Me.txtTaxcode.Text = Rst.Fields("Taxcode").Value
    Me.txtBar.Text = Rst.Fields("Bar").Value
    Me.txtBankcode.Text = Rst.Fields("Bankcode").Value
    Me.txtBankname.Text = Rst.Fields("Bankname").Value
    Me.Combo_Banklevel.Text = Rst.Fields("Banklevel").Value
    Me.txtJurPerson.Text = Rst.Fields("Jurperson").Value
    Me.txtJurphone.Text = Rst.Fields("Jurphone").Value
    Me.txtJurFax.Text = Rst.Fields("Jurfax").Value
    Me.txtViaPerson.Text = Rst.Fields("Viaperson").Value
    Me.txtViaphone.Text = Rst.Fields("Viaphone").Value
    Me.txtViaFax.Text = Rst.Fields("Viafax").Value
    If Rst.Fields("Note").Value = "无" Then
        Me.txtNote.Text = ""
    Else
        Me.txtNote.Text = Rst.Fields("Note").Value
    End If
    Me.lblNowDate.Caption = "今天日期： " & Format(Date, "yyyy年m月d日")
    Me.Height = 7350                    '设置窗体外观
    Me.Width = 9930
End Sub

Private Function SuppInfo_Change() As Boolean   '单击修改按钮，返回True说明修改成功，False不成功
    Dim Rst As New ADODB.Recordset
    Dim strSQL As String
    
On Error GoTo ErrorExit
    SuppInfo_Change = False         '默认修改信息还不成功
    If CheckFaceIsOk = False Then   '引用函数判断是否可以进行修改信息的操作
        Exit Function
    End If
    strSQL = "SELECT * FROM tb_Supplier WHERE SuppID ='S" & Me.txtSuppID.Text & "'" '准备进行修改
    Rst.Open strSQL, CnnDatabase, adOpenStatic, adLockOptimistic    '打开一个动态记录集
    If Rst.RecordCount = 0 Then
        MsgBox "此供应商不在数据库中！", vbCritical, "数据库错误-"
        Exit Function
    End If
    If Rst.RecordCount > 1 Then
        MsgBox "此供应商在数据库中不唯一！", vbCritical, "数据库错误-"
        Exit Function
    End If
    Rst.Fields("SuppName").Value = Me.txtSuppName.Text              '开始修改数据库中这个供应商的信息
    Rst.Fields("RegeditDate").Value = Me.DT_RegeditDate.Value
    Rst.Fields("SuppAddress").Value = Me.txtSuppAddress.Text
    Rst.Fields("RegeditName").Value = Me.txtRegeditName.Text
    Rst.Fields("LimitStart").Value = Me.DT_LimitStart.Value
    Rst.Fields("LimitEnd").Value = Me.DT_LimitEnd.Value
    Rst.Fields("Postcode").Value = Me.txtPostcode.Text
    Rst.Fields("Email").Value = Me.txtEmail.Text
    Rst.Fields("Website").Value = Me.txtWebSite.Text
    Rst.Fields("Type").Value = Me.Combo_Type.Text
    Rst.Fields("Property").Value = Me.txtProperty.Text
    Rst.Fields("Regeditfund").Value = Me.txtRegeditfund.Text
    Rst.Fields("RegeditMoney").Value = Me.txtRegeditMoney.Text
    Rst.Fields("Regeditcode").Value = Me.txtRegeditcode.Text
    Rst.Fields("Supplevel").Value = Me.Combo_Supplevel.Text
    Rst.Fields("Taxcode").Value = Me.txtTaxcode.Text
    Rst.Fields("Bar").Value = Me.txtBar.Text
    Rst.Fields("Bankcode").Value = Me.txtBankcode.Text
    Rst.Fields("Bankname").Value = Me.txtBankname.Text
    Rst.Fields("Banklevel").Value = Me.Combo_Banklevel.Text
    Rst.Fields("Jurperson").Value = Me.txtJurPerson.Text
    Rst.Fields("Jurphone").Value = Me.txtJurphone.Text
    Rst.Fields("Jurfax").Value = Me.txtJurFax.Text
    Rst.Fields("Viaperson").Value = Me.txtViaPerson.Text
    Rst.Fields("Viaphone").Value = Me.txtViaphone.Text
    Rst.Fields("Viafax").Value = Me.txtViaFax.Text
    If Me.txtNote.Text = "" Then
        Rst.Fields("Note").Value = "无"
    Else
        Rst.Fields("Note").Value = Me.txtNote.Text
    End If
    Rst.Update              '修改信息结束
    MsgBox "此供应商信息修改成功！", vbInformation, "操作成功-"
    Set Rst = Nothing
    Initial_Change          '刷新界面
    SuppInfo_Change = False '修改信息成功了
    Exit Function
    
ErrorExit:
    MsgBox Err.Description, vbCritical, Me.Caption
End Function

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    Module1.strSuppID = ""  '清除更改供应商的名字
    Unload frmType          '关闭增删供货类别的窗体
End Sub

'在添加或修改信息前判断界面是否正确，例如控件内容不为空，数字、位数是否正确等。
Private Function CheckFaceIsOk() As Boolean
    Dim intText As Integer  '记录textbox控件中每位字符所在第几位
    Dim strText As String   '指向textbox控件中的每一位字符
    
On Error GoTo ErrorExit
    CheckFaceIsOk = True                    '表示默认界面正确了
    If Me.txtSuppName = "" Then             '供应商名称不能为空
        MsgBox "供应商名称栏不能为空！", vbCritical, Me.Caption
        Me.txtSuppName.SetFocus             '设置焦点
        CheckFaceIsOk = False               '说明界面不正确！
        Exit Function                       '退出系统
    End If
    If Me.txtSuppID = "" Then               '供应商代码不能为空
        MsgBox "供应商代码栏不能为空！", vbCritical, Me.Caption
        Me.txtSuppID.SetFocus               '设置焦点
        CheckFaceIsOk = False               '说明界面不正确！
        Exit Function                       '退出系统
    End If
    If Me.txtSuppAddress = "" Then          '供应商地址不能为空
        MsgBox "供应商地址栏不能为空！", vbCritical, Me.Caption
        Me.txtSuppAddress.SetFocus          '设置焦点
        CheckFaceIsOk = False               '说明界面不正确！
        Exit Function                       '退出系统
    End If
    If Me.txtRegeditName = "" Then          '注册名称不能为空
        MsgBox "注册名称栏不能为空！", vbCritical, Me.Caption
        Me.txtRegeditName.SetFocus          '设置焦点
        CheckFaceIsOk = False               '说明界面不正确！
        Exit Function                       '退出系统
    End If
    If Me.txtPostcode = "" Then             '邮政编码不能为空
        MsgBox "邮政编码栏不能为空！", vbCritical, Me.Caption
        Me.txtPostcode.SetFocus             '设置焦点
        CheckFaceIsOk = False               '说明界面不正确！
        Exit Function                       '退出系统
    End If
    If Me.txtEmail = "" Then                '邮件地址不能为空
        MsgBox "邮件地址栏不能为空！", vbCritical, Me.Caption
        Me.txtEmail.SetFocus                '设置焦点
        CheckFaceIsOk = False               '说明界面不正确！
        Exit Function                       '退出系统
    End If
    If Me.txtWebSite = "" Then              '供应商网址不能为空
        MsgBox "供应商网址栏不能为空！", vbCritical, Me.Caption
        Me.txtWebSite.SetFocus              '设置焦点
        CheckFaceIsOk = False               '说明界面不正确！
        Exit Function                       '退出系统
    End If
    If Me.Combo_Type.Text = "" Then         '供货类别不能为空
        MsgBox "供货类别栏不能为空！", vbCritical, Me.Caption
        Me.Combo_Type.SetFocus              '设置焦点
        CheckFaceIsOk = False               '说明界面不正确！
        Exit Function                       '退出系统
    End If
    If Me.txtProperty = "" Then             '企业性质不能为空
        MsgBox "企业性质一栏不能为空！", vbCritical, Me.Caption
        Me.txtProperty.SetFocus             '设置焦点
        CheckFaceIsOk = False               '说明界面不正确！
        Exit Function                       '退出系统
    End If
    If Me.txtRegeditfund = "" Then          '注册资金不能为空
        MsgBox "注册资金栏不能为空！", vbCritical, Me.Caption
        Me.txtRegeditfund.SetFocus          '设置焦点
        CheckFaceIsOk = False               '说明界面不正确！
        Exit Function                       '退出系统
    End If
    If Me.txtRegeditMoney = "" Then         '注册币种不能为空
        MsgBox "注册币种栏不能为空！", vbCritical, Me.Caption
        Me.txtRegeditMoney.SetFocus         '设置焦点
        CheckFaceIsOk = False               '说明界面不正确！
        Exit Function                       '退出系统
    End If
    If Me.txtRegeditcode = "" Then          '注册号码不能为空
        MsgBox "注册号码栏不能为空！", vbCritical, Me.Caption
        Me.txtRegeditcode.SetFocus          '设置焦点
        CheckFaceIsOk = False               '说明界面不正确！
        Exit Function                       '退出系统
    End If
    If Me.Combo_Supplevel.Text = "" Then    '供应商级别不能为空
        MsgBox "供应商级别栏不能为空！", vbCritical, Me.Caption
        Me.Combo_Supplevel.SetFocus         '设置焦点
        CheckFaceIsOk = False               '说明界面不正确！
        Exit Function                       '退出系统
    End If
    If Me.txtTaxcode = "" Then              '税号不能为空
        MsgBox "税号栏不能为空！", vbCritical, Me.Caption
        Me.txtTaxcode.SetFocus              '设置焦点
        CheckFaceIsOk = False               '说明界面不正确！
        Exit Function                       '退出系统
    End If
    If Me.txtBar = "" Then                  '条形码证书不能为空
        MsgBox "条形码证书栏不能为空！", vbCritical, Me.Caption
        Me.txtBar.SetFocus                  '设置焦点
        CheckFaceIsOk = False               '说明界面不正确！
        Exit Function                       '退出系统
    End If
    If Me.txtBankcode = "" Then             '银行账号不能为空
        MsgBox "银行账号栏不能为空！", vbCritical, Me.Caption
        Me.txtBankcode.SetFocus             '设置焦点
        CheckFaceIsOk = False               '说明界面不正确！
        Exit Function                       '退出系统
    End If
    If Me.txtBankname = "" Then             '开户行不能为空
        MsgBox "开户行栏不能为空！", vbCritical, Me.Caption
        Me.txtBankname.SetFocus             '设置焦点
        CheckFaceIsOk = False               '说明界面不正确！
        Exit Function                       '退出系统
    End If
    If Me.Combo_Banklevel.Text = "" Then    '银行信用等级不能为空
        MsgBox "银行信用等级栏不能为空！", vbCritical, Me.Caption
        Me.Combo_Banklevel.SetFocus         '设置焦点
        CheckFaceIsOk = False               '说明界面不正确！
        Exit Function                       '退出系统
    End If
    If Me.txtJurPerson = "" Then            '法人代表不能为空
        MsgBox "法人代表一栏不能为空！", vbCritical, Me.Caption
        Me.txtJurPerson.SetFocus            '设置焦点
        CheckFaceIsOk = False               '说明界面不正确！
        Exit Function                       '退出系统
    End If
    If Me.txtJurphone = "" Then             '法人电话不能为空
        MsgBox "法人电话栏不能为空！", vbCritical, Me.Caption
        Me.txtJurphone.SetFocus             '设置焦点
        CheckFaceIsOk = False               '说明界面不正确！
        Exit Function                       '退出系统
    End If
    If Me.txtJurFax = "" Then               '法人传真不能为空
        MsgBox "法人传真栏不能为空！", vbCritical, Me.Caption
        Me.txtJurFax.SetFocus               '设置焦点
        CheckFaceIsOk = False               '说明界面不正确！
        Exit Function                       '退出系统
    End If
    If Me.txtViaPerson = "" Then            '经办人不能为空
        MsgBox "经办人栏不能为空！", vbCritical, Me.Caption
        Me.txtViaPerson.SetFocus            '设置焦点
        CheckFaceIsOk = False               '说明界面不正确！
        Exit Function                       '退出系统
    End If
    If Me.txtViaphone = "" Then             '经办人电话不能为空
        MsgBox "经办人电话栏不能为空！", vbCritical, Me.Caption
        Me.txtViaphone.SetFocus             '设置焦点
        CheckFaceIsOk = False               '说明界面不正确！
        Exit Function                       '退出系统
    End If
    If Me.txtViaFax = "" Then               '经办人传真不能为空
        MsgBox "经办人传真栏不能为空！", vbCritical, Me.Caption
        Me.txtViaFax.SetFocus               '设置焦点
        CheckFaceIsOk = False               '说明界面不正确！
        Exit Function                       '退出系统
    End If
    
    If Len(Me.txtSuppID.Text) <> 8 Then            '判断供应商代码一栏必须是8位
        MsgBox "供应商代码一栏必须用8位纯数字填写！", vbCritical, "错误-"
        Me.txtSuppID.Text = ""
        Me.txtSuppID.SetFocus
        CheckFaceIsOk = False               '说明界面不正确！
        Exit Function
    End If
    For intText = 1 To Len(Me.txtSuppID.Text)      '用数字填写供应商代码栏
        strText = Asc(Mid(Me.txtSuppID.Text, intText, 1))
        If strText < 48 Or strText > 57 Then
            MsgBox "请用数字填写供应商代码栏内容！", vbCritical, Me.Caption
            Me.txtSuppID.Text = ""
            Me.txtSuppID.SetFocus
            CheckFaceIsOk = False               '说明界面不正确！
            Exit Function
        End If
    Next
    For intText = 1 To Len(Me.txtPostcode.Text)      '用数字填写邮政编码栏
        strText = Asc(Mid(Me.txtPostcode.Text, intText, 1))
        If strText < 48 Or strText > 57 Then
            MsgBox "请用数字填写邮政编码栏内容！", vbCritical, Me.Caption
            Me.txtPostcode.Text = ""
            Me.txtPostcode.SetFocus
            CheckFaceIsOk = False               '说明界面不正确！
            Exit Function
        End If
    Next
    For intText = 1 To Len(Me.txtRegeditfund.Text)   '用数字填写注册资金栏
        strText = Asc(Mid(Me.txtRegeditfund.Text, intText, 1))
        If strText < 48 Or strText > 57 Then
            MsgBox "请用数字填写注册资金栏内容！", vbCritical, Me.Caption
            Me.txtRegeditfund.Text = ""
            Me.txtRegeditfund.SetFocus
            CheckFaceIsOk = False               '说明界面不正确！
            Exit Function
        End If
    Next
    For intText = 1 To Len(Me.txtRegeditcode.Text)   '用数字填写注册号码栏
        strText = Asc(Mid(Me.txtRegeditcode.Text, intText, 1))
        If strText < 48 Or strText > 57 Then
            MsgBox "请用数字填写注册号码栏内容！", vbCritical, Me.Caption
            Me.txtRegeditcode.Text = ""
            Me.txtRegeditcode.SetFocus
            CheckFaceIsOk = False               '说明界面不正确！
            Exit Function
        End If
    Next
    For intText = 1 To Len(Me.Combo_Supplevel.Text)   '用数字填写供应商级别栏
        strText = Asc(Mid(Me.Combo_Supplevel.Text, intText, 1))
        If strText < 48 Or strText > 57 Then
            MsgBox "请用数字填写供应商级别栏内容！", vbCritical, Me.Caption
            Me.Combo_Supplevel.Text = ""
            Me.Combo_Supplevel.SetFocus
            CheckFaceIsOk = False               '说明界面不正确！
            Exit Function
        End If
    Next
    For intText = 1 To Len(Me.txtTaxcode.Text)        '用数字填写税号栏
        strText = Asc(Mid(Me.txtTaxcode.Text, intText, 1))
        If strText < 48 Or strText > 57 Then
            MsgBox "请用数字填写税号栏内容！", vbCritical, Me.Caption
            Me.txtTaxcode.Text = ""
            Me.txtTaxcode.SetFocus
            CheckFaceIsOk = False               '说明界面不正确！
            Exit Function
        End If
    Next
    For intText = 1 To Len(Me.txtBankcode.Text)      '用数字填写银行账号栏
        strText = Asc(Mid(Me.txtBankcode.Text, intText, 1))
        If strText < 48 Or strText > 57 Then
            MsgBox "请用数字填写银行账号栏内容！", vbCritical, Me.Caption
            Me.txtBankcode.Text = ""
            Me.txtBankcode.SetFocus
            CheckFaceIsOk = False               '说明界面不正确！
            Exit Function
        End If
    Next
    For intText = 1 To Len(Me.txtJurphone.Text)      '用数字填写法人电话栏
        strText = Asc(Mid(Me.txtJurphone.Text, intText, 1))
        If strText < 48 Or strText > 57 Then
            MsgBox "请用数字填写法人电话栏内容！", vbCritical, Me.Caption
            Me.txtJurphone.Text = ""
            Me.txtJurphone.SetFocus
            CheckFaceIsOk = False               '说明界面不正确！
            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
            CheckFaceIsOk = False               '说明界面不正确！
            Exit Function
        End If
    Next
    For intText = 1 To Len(Me.txtViaphone.Text)      '用数字填写经办人电话栏
        strText = Asc(Mid(Me.txtViaphone.Text, intText, 1))
        If strText < 48 Or strText > 57 Then
            MsgBox "请用数字填写经办人电话栏内容！", vbCritical, Me.Caption
            Me.txtViaphone.Text = ""
            Me.txtViaphone.SetFocus
            CheckFaceIsOk = False               '说明界面不正确！
            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
            CheckFaceIsOk = False               '说明界面不正确！
           Exit Function
        End If
    Next
    If Me.DT_LimitStart.Value > Me.DT_LimitEnd.Value Then   '业务开始期限 < 结束期限
        MsgBox "业务执行期限的开始日期不得小于结束日期！", vbCritical, Me.Caption
        CheckFaceIsOk = False               '说明界面不正确！
        Exit Function
    End If
    Exit Function
    
ErrorExit:
    MsgBox Err.Description, vbCritical, Me.Caption
End Function