📄 客户档案管理.frm
字号:
End
Begin VB.Label Label7
Caption = "税号："
Height = 225
Left = 810
TabIndex = 7
Top = 3720
Width = 855
End
Begin VB.Label Label6
Caption = "帐号："
Height = 465
Left = 810
TabIndex = 6
Top = 3120
Width = 1095
End
Begin VB.Label Label5
Caption = "开户行："
Height = 345
Left = 630
TabIndex = 5
Top = 2580
Width = 1125
End
Begin VB.Label Label4
Caption = "指定应收款："
Height = 315
Left = 270
TabIndex = 4
Top = 2040
Width = 1185
End
Begin VB.Label Label3
Caption = "客户类别："
Height = 315
Left = 450
TabIndex = 3
Top = 1470
Width = 1065
End
Begin VB.Label Label2
BackStyle = 0 'Transparent
Caption = "客户名称："
Height = 285
Left = 450
TabIndex = 2
Top = 960
Width = 945
End
Begin VB.Label Label1
Alignment = 2 'Center
BackColor = &H00FFFFFF&
BackStyle = 0 'Transparent
Caption = "客户编码："
Height = 255
Index = 0
Left = 360
TabIndex = 1
Top = 510
Width = 1125
End
End
End
Attribute VB_Name = "客户档案管理"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Sub Command1_Click()
Dim txtsql As String
Dim txtsql1(0 To 13) As String
Dim mrc As ADODB.Recordset
Dim msgtext As String
If Trim(Text1(1).Text) = "" Then
MsgBox "请输入客户名称！", vbOKOnly + vbExclamation, "警告"
Exit Sub
Text1(1).SetFocus
Else
txtsql = "select * from 数据存取表"
Set mrc = ExecuteSQL(txtsql, msgtext)
While (mrc.EOF = False)
If Trim(mrc.Fields(34)) = Trim(Text1(1)) Then
MsgBox "该客户已经存在，请单击修改项！", vbOKOnly + vbExclamation, "警告"
Exit Sub
Else
mrc.MoveNext
End If
Wend
End If
mrc.AddNew
mrc.Fields(33) = Trim(Text1(0).Text)
mrc.Fields(34) = Trim(Text1(1).Text)
mrc.Fields(35) = Trim(Text1(2).Text)
mrc.Fields(20) = Trim(Text1(3).Text)
mrc.Fields(21) = Trim(Text1(4).Text)
mrc.Fields(22) = Trim(Text1(5).Text)
mrc.Fields(23) = Trim(Text1(6).Text)
mrc.Fields(24) = Trim(Text1(7).Text)
mrc.Fields(25) = Trim(Text1(8).Text)
mrc.Fields(26) = Trim(Text1(9).Text)
mrc.Fields(27) = Trim(Text1(10).Text)
mrc.Fields(28) = Trim(Text1(11).Text)
mrc.Fields(29) = Trim(Text1(12).Text)
mrc.Fields(30) = Trim(Text1(13).Text)
mrc.Fields(32) = Trim(Text1(15).Text)
mrc.Fields(31) = Trim(Combo1.Text)
mrc.Update
mrc.Close
MsgBox "添加客户成功！", vbOKOnly + vbExclamation, "添加客户"
End Sub
Private Sub Command2_Click()
Dim mrc As ADODB.Recordset
Dim msgtext As String
Dim i, b, c, d As Integer
Dim v As Integer
For i = 0 To 13
If Trim(Text1(i).Text) = "" Then v = v + 1
Next i
If v = 14 And Trim(Text1(15).Text) <> "" And Trim(Combo1.Text) <> "" Then
MsgBox "没有选择查询条件！"
Exit Sub
End If
Dim txtsql(0 To 15) As String
Dim K(0 To 13) As Integer
For d = 0 To 13
If Trim(Text1(d).Text) <> "" Then
K(d) = d
Select Case K(d)
Case 0
txtsql(0) = "select * from 数据存取表 where 客户编码 = '" & Text1(0).Text & "'"
Set mrc = ExecuteSQL(txtsql(0), msgtext)
If mrc.EOF = True Then
MsgBox "对不起，暂时没有符合条件的客户!", vbOKOnly + vbExclamation, "警告"
End If
Case 1
txtsql(1) = "select * from 数据存取表 where 客户名称 = '" & Text1(1).Text & "'"
Set mrc = ExecuteSQL(txtsql(1), msgtext)
If mrc.EOF = True Then
MsgBox "对不起，暂时没有符合条件的客户!", vbOKOnly + vbExclamation, "警告"
End If
Case 2
txtsql(2) = "select * from 数据存取表 where 客户类别 = '" & Text1(2).Text & "'"
Set mrc = ExecuteSQL(txtsql(2), msgtext)
If mrc.EOF = True Then
MsgBox "对不起，暂时没有符合条件的客户!", vbOKOnly + vbExclamation, "警告"
End If
Case 3
txtsql(3) = "select * from 数据存取表 where 指定银行收款 = '" & Text1(3).Text & "'"
Set mrc = ExecuteSQL(txtsql(3), msgtext)
If mrc.EOF = True Then
MsgBox "对不起，暂时没有符合条件的客户!", vbOKOnly + vbExclamation, "警告"
End If
Case 4
txtsql(4) = "select * from 数据存取表 where 开户行 = '" & Text1(4).Text & "'"
Set mrc = ExecuteSQL(txtsql(4), msgtext)
If mrc.EOF = True Then
MsgBox "对不起，暂时没有符合条件的客户!", vbOKOnly + vbExclamation, "警告"
End If
Case 5
txtsql(5) = "select * from 数据存取表 where 帐号 = '" & Text1(5).Text & "'"
Set mrc = ExecuteSQL(txtsql(5), msgtext)
If mrc.EOF = True Then
MsgBox "对不起，暂时没有符合条件的客户!", vbOKOnly + vbExclamation, "警告"
End If
Case 6
txtsql(6) = "select * from 数据存取表 where 税号 = '" & Text1(6).Text & "'"
Set mrc = ExecuteSQL(txtsql(6), msgtext)
If mrc.EOF = True Then
MsgBox "对不起，暂时没有符合条件的客户!", vbOKOnly + vbExclamation, "警告"
End If
Case 7
txtsql(7) = "select * from 数据存取表 where 地址 = '" & Text1(7).Text & "'"
Set mrc = ExecuteSQL(txtsql(7), msgtext)
If mrc.EOF = True Then
MsgBox "对不起，暂时没有符合条件的客户!", vbOKOnly + vbExclamation, "警告"
End If
Case 8
txtsql(8) = "select * from 数据存取表 where 网址 = '" & Text1(8).Text & "'"
Set mrc = ExecuteSQL(txtsql(8), msgtext)
If mrc.EOF = True Then
MsgBox "对不起，暂时没有符合条件的客户!", vbOKOnly + vbExclamation, "警告"
End If
Case 9
txtsql(9) = "select * from 数据存取表 where [E-mail]= '" & Text1(9).Text & "'"
Set mrc = ExecuteSQL(txtsql(9), msgtext)
If mrc.EOF = True Then
MsgBox "对不起，暂时没有符合条件的客户!", vbOKOnly + vbExclamation, "警告"
End If
Case 10
txtsql(10) = "select * from 数据存取表 where 邮编= '" & Text1(10).Text & "'"
Set mrc = ExecuteSQL(txtsql(10), msgtext)
If mrc.EOF = True Then
MsgBox "对不起，暂时没有符合条件的客户!", vbOKOnly + vbExclamation, "警告"
End If
Case 11
txtsql(11) = "select * from 数据存取表 where 法人= '" & Text1(11).Text & "'"
Set mrc = ExecuteSQL(txtsql(11), msgtext)
If mrc.EOF = True Then
MsgBox "对不起，暂时没有符合条件的客户!", vbOKOnly + vbExclamation, "警告"
End If
Case 12
txtsql(12) = "select * from 数据存取表 where 电话= '" & Text1(12).Text & "'"
Set mrc = ExecuteSQL(txtsql(12), msgtext)
If mrc.EOF = True Then
MsgBox "对不起，暂时没有符合条件的客户!", vbOKOnly + vbExclamation, "警告"
End If
Case 13
txtsql(13) = "select * from 数据存取表 where 传真= '" & Text1(13).Text & "'"
Set mrc = ExecuteSQL(txtsql(13), msgtext)
If mrc.EOF = True Then
MsgBox "对不起，暂时没有符合条件的客户!", vbOKOnly + vbExclamation, "警告"
End If
End Select
End If
Next d
txtsql(14) = "select * from 数据存取表 where 省内外='" & Combo1.Text & "'"
Set mrc = ExecuteSQL(txtsql(14), msgtext)
If mrc.EOF = True Then
MsgBox "对不起，暂时没有符合条件的客户!", vbOKOnly + vbExclamation, "警告"
End If
txtsql(15) = "select * from 数据存取表 where 联系人='" & Text1(15).Text & "'"
Set mrc = ExecuteSQL(txtsql(15), msgtext)
If mrc.EOF = True Then
MsgBox "对不起，暂时没有符合条件的客户!", vbOKOnly + vbExclamation, "警告"
End If
数据查询结果.txtsql = txtsql(0) & txtsql(1) & txtsql(2) & txtsql(3) & txtsql(4) & txtsql(5) & txtsql(6) & txtsql(7) & txtsql(8) & txtsql(9) & txtsql(10) & txtsql(11) & txtsql(12) & txtsql(13) & txtsql(14) & txtsql(15)
数据查询结果.Show
End Sub
Private Sub Command3_Click()
Dim intCount As Integer
If flaggedit Then
If 数据查询结果.msglist.Rows > 1 Then
intCount = 数据查询结果.msglist.Row
数据查询结果.txtsql = "select * from 数据存取表 where 客户编号='" & Trim(数据查询结果.msglist.TextMatrix(intCount, 1)) & "'"
数据查询结果.Show
Else
Call Command2_Click
End If
Else
数据查询结果.txtsql = "select * from 数据存取表"
数据查询结果.Show
End If
End Sub
Private Sub Command4_Click()
Unload Me
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -