📄 供应商档案管理.frm
字号:
End
Begin VB.Label Label8
Caption = "电话："
Height = 405
Index = 0
Left = 5100
TabIndex = 8
Top = 4830
Width = 855
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 = 240
TabIndex = 3
Top = 1470
Width = 1425
End
Begin VB.Label Label2
BackStyle = 0 'Transparent
Caption = "供应商名称："
Height = 285
Left = 270
TabIndex = 2
Top = 960
Width = 1125
End
Begin VB.Label Label1
Alignment = 2 'Center
BackColor = &H00FFFFFF&
BackStyle = 0 'Transparent
Caption = "供应商编码："
Height = 255
Index = 0
Left = 270
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, "警告"
Text1(1).SetFocus
Exit Sub
Text1(1).SetFocus
Else
txtSQL = "select * from 供应商信息表"
Set mrc = ExecuteSQL(txtSQL, MsgText)
While (mrc.EOF = False)
If Trim(mrc.Fields("供应商名称")) = Trim(Text1(1)) Then
MsgBox "该供应商已经存在！", vbOKOnly + vbExclamation, "警告"
Exit Sub
Else
mrc.MoveNext
End If
Wend
End If
mrc.AddNew
mrc.Fields("供应商编码") = Trim(Text1(0).Text)
mrc.Fields("供应商名称") = Trim(Text1(1).Text)
mrc.Fields("供应商类别") = Trim(Text1(2).Text)
mrc.Fields("指定应收款") = Trim(Text1(3).Text)
mrc.Fields("开户行") = Trim(Text1(4).Text)
mrc.Fields("帐号") = Trim(Text1(5).Text)
mrc.Fields("税号") = Trim(Text1(6).Text)
mrc.Fields("地址") = Trim(Text1(7).Text)
mrc.Fields("网址") = Trim(Text1(8).Text)
mrc.Fields("E-mail") = Trim(Text1(9).Text)
mrc.Fields("邮编") = Trim(Text1(10).Text)
mrc.Fields("法人") = Trim(Text1(11).Text)
mrc.Fields("电话") = Trim(Text1(12).Text)
mrc.Fields("传真") = Trim(Text1(13).Text)
mrc.Fields("联系人") = Trim(Text1(15).Text)
mrc.Fields("省内外") = Trim(Combo1.Text)
MsgBox "添加供应商信息成功！", vbOKOnly + vbExclamation, "添加信息"
mrc.Update
mrc.Close
MsgBox "添加供应商成功！", vbOKOnly + vbExclamation, "添加供应商"
End Sub
Private Sub Command2_Click()
Dim mrc As ADODB.Recordset
Dim txtSQL(0 To 15) As String
Dim MsgText As String
Dim K(0 To 13) As Integer
Dim i, 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 Then
MsgBox "没有选择查询条件！"
Exit Sub
End If
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 指定应收款 = '" & 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 Command4_Click()
Unload Me
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -