仓库管理系统(VB+Access+源代码).doc

仓库管理系统
项目的建立
这是本人利用闲暇之余在VB6.0上制作的一个简陋的类库管系统，现图文结合的方式一步一步展现制作过程。由于本人是个初学者,里面存在很多不足之处望得到高手们的指导.此文可作供初学者们学习交流.作者联系方式：E—mail luo.shiye＠yahoo。 QQ：1355044347
最终运行效果
打开软件出现如下登录界面
输入系统预设用户名及密码（ 1 1 ）单击“登录”或单击“新用户”添加新用户进入如下主界面：
建立工程
1、 创建标准EXE
2、 按“打开"
3、 添加MDI窗体——打开
4、 编辑菜单
在空白处右击——点击“菜单编辑器”

在“标题”里输入“系统”，在“名称”里输入“Sys”(注意此处不能为汉字)

点击“下一个”再点击“ "

“确定”退到MDI界面点击“系统”——“退出”如下，然后编写代码.
代码如下:
Private Sub Exit_Click（)
End
End Sub
数据库的建立
VB6.0中可以创建Access数据库。如下建立一个“用户表”的数据库,用来存放用户信息及一些出入库管理信息。如下图单击“外接程序"
再单击“可视化数据管理器”出现如图
点击“文件”——“新建"—-“Microsoft Access”-—“Version 2.0 MDB”输入数据库名,“保存"出现如下图
在数据窗口中右击——“新建表”，最终如下
往数据表里添加数据在这里就不罗嗦了，请查阅相关书籍。
登录界面窗口的建立
最终界面如下：
1、Adodc1的添加过程为：单击“工程"-—“部件”出现下图所示，选择“控件”下的“Microsoft ADO Data Control 6.0 (OLEDB）”
单击“确定”在工具栏中会出现“”图标，单击它并拖动到相应位置即可。其它元件不在一一说明。
2、 本窗体代码如下：
Private Sub Command1_Click（) ’“登录”、“确定”按钮
If Command1.Caption = "确定" And Command2.Caption = ”取消" Then '如果为“确定”则添加新用户
If Text1。Text = "” Then ’提示用户输入用户名
MsgBox "请输入用户名！”, ， "登录信息提示："
Exit Sub
Else ’
Dim usename As String ’检测用户名是否已经存在
Dim strS As String
usename = Trim(Text1。Text）
strS = "select ＊ from 用户登录信息表 where 用户名='" ＆ usename ＆ "'"
Adodc1.CommandType = adCmdText
Adodc1。RecordSource = strS
Adodc1.Refresh
If Adodc1。Recordset。EOF = False Then
MsgBox ”您输入的用户已存在！”, ， ”登录提示信息:"
Text1。Text = "”
Text2。Text = ""
Text3。Text = ”"
Text1。SetFocus
Exit Sub
End If
End If
If Text2。Text = "" Then '提示用户密码不能为空
MsgBox "密码不能为空!”, ， "登录提示信息："
Text2.SetFocus
Exit Sub
End If
If Text3.Text = ”" Then
MsgBox "请再次输入密码！"， ， ”登录提示信息："
Text3。SetFocus
Exit Sub
End If
If Text2.Text <> Text3.Text Then
MsgBox "两次输入的密码不一致,请确认!", , ”登录提示信息：”
Text2。Text = ””
Text3。Text = ””
Text2。SetFocus
Exit Sub
Else
Adodc1。Recordset。AddNew '添加新用户
Adodc1。Recordset。Fields（”用户名") = Trim(Text1。Text）
Adodc1。Recordset。Fields(”密码") = Trim（Text2.Text）
Adodc1.Recordset.Update
MsgBox ("添加新用户成功，现在您可以登陆系统了！”)
Label3。Visible = False
Text3。Visible = False
Command1。Caption = "登录"
Command2.Caption = "退出"
End If
Else '“登录”按钮，用户登录
Dim strSno As String
Dim strSelect As String
strSno = Trim（Text1.Text) '检测用户名是否存在
strSelect = ”select 密码 from 用户登录信息表 where 用户名 = '” & strSno ＆ "’”
Adodc1.CommandType = adCmdText
Adodc1.RecordSource = strSelect
Adodc1。Refresh
If Adodc1.Recordset。EOF = True Then
MsgBox "用户名不存在，请重新输入!”， , ”登录提示信息："
Text1。Text = ””
Text2。Text = ””
Text1。SetFocus
Exit Sub
End If
If Adodc1.Recordset。Fields（"密码”) = Trim（Text2。Text） Then '检测密码是否正确
Form1.Hide
’Unload Me
Form2.Show
’MsgBox "登陆成功！”， , ”登录提示信息：”
Else
MsgBox "密码不正确，请重新输入!"， ， ”登录提示信息："
Text2。Text = ""
Text2.SetFocus
End If
End If
End Sub
Private Sub Command2_Click(） ’“退出”或“取消”按钮
If Command2.Caption = ”取消" Then
Label3。Visible = False
Text3.Visible = False
Command1。Caption = "登录"
Command2。Caption = "退出"
Text1.Text = "”
Text2.Text = ””
Text1.SetFocus
Else
End 'Unload Me
End If
End Sub
Private Sub Command3_Click（） ’“新用户”按钮
Label3。Visible = True
Text3。Visible = True
Text1。Text = ""
Text2。Text = "”
Text3.Text = ”"
Command1.Caption = "确定”
Command2。Caption = ”取消"
Text1。SetFocus
End Sub
Private Sub Command3_MouseDown（Button As Integer， Shift As Integer, X As Single， Y As Single）
Label6。Visible = True
End Sub
Private Sub Command3_MouseUp（Button As Integer, Shift As Integer， X As Single, Y As Single)
Label6.Visible = False
End Sub
Private Sub Form_Load（）
Label3。Visible = False
Text3.Visible = False
End Sub
Private Sub Timer1_Timer() ’时间time1控件的time事件代码，用来
'显示向左移动的欢迎字幕
If Label4.Left + Label4.Width 〉 0 Then ’当标签右边位置大于0时,标签向左移
Label4。Move Label4。Left - 80
Else ’否则标签从头开始
Label4.Left = Form1。ScaleWidth
End If
If Label5.Left + Label5。Width > 0 Then
Label5。Move Label5.Left - 80
Else
Label5。Left = Form1.ScaleWidth
End If
End Sub
主界面窗体
如下：
代码：
Private Sub AddNew_Click(）
Frame1。Visible = True
Frame2。Visible = False
End Sub
Private Sub CHKPMCHX_Click(）
Frame2.Caption = ”出库信息"
Dim pm As String
Dim n As String
pm = InputBox(”产品名”, "请输入”， 0)
n = "select ＊ from 出库表 where 品名 = '" ＆ pm ＆ "'”
Adodc2。CommandType = adCmdText
Adodc2.RecordSource = n
Adodc2。Refresh
Call InitGrid1
End Sub
Private Sub CHKXHCHX_Click(）
Frame2.Caption = ”出库信息"
Dim XH As String
Dim n As String
XH = InputBox（”产品型号”, "请输入", 0）
n = "select ＊ from 出库表 where 型号 = '" & XH & "'”
Adodc2。CommandType = adCmdText
Adodc2.RecordSource = n
Adodc2。Refresh
End Sub
Private Sub CKCZ_Click（）
'Form2。Hide
Form6。Show
End Sub
Private Sub CKJSHR_Click(）
Frame2.Caption = "出库信息”
Dim JSHR As String
Dim n As String
JSHR = InputBox（"经手人", ”请输入"， 0)
n = "select * from 出库表 where 经手人 = ’" & JSHR ＆ "’”
Adodc2.CommandType = adCmdText
Adodc2.RecordSource = n
Adodc2.Refresh
Call InitGrid1
End Sub
Private Sub CKSHJ_Click(）
Frame2.Caption = "出库信息"
Dim CHKRQ As String
Dim n As String
CHKRQ = InputBox（”出库日期，格式为：月/日/年 如:12/1/2011", "请输入"， 0)
n = "select * from 出库表 where 出库日期 = ’” & CHKRQ ＆ "’"
Adodc2。CommandType = adCmdText
Adodc2。RecordSource = n
Adodc2.Refresh
Call InitGrid1
End Sub
Private Sub CKZCX_Click(）
Frame2.Caption = "出库信息”
Dim ZB As String
ZB = "select ＊ from 出库表 "
Adodc2。CommandType = adCmdText
Adodc2。RecordSource = ZB
Adodc2。Refresh
Call InitGrid1
End Sub
Private Sub Command1_Click（）
If Text1。Text = ”” Then ’提示用户输入用户名
MsgBox ”请输入用户名!”, , "登录信息提示："
Exit Sub
Else ’
Dim usename As String ’检测用户名是否已经存在
Dim strS As String
usename = Trim（Text1.Text）
strS = "select * from 用户登录信息表 where 用户名='” & usename ＆ "’"
Adodc1。CommandType = adCmdText
Adodc1.RecordSource = strS
Adodc1。Refresh
If Adodc1.Recordset.EOF = False Then
MsgBox ”您输入的用户已存在!", , "登录提示信息：”
Text1.Text = ””
Text2。Text = ”"
Text3.Text = ”"
Text1。SetFocus
Exit Sub
End If
End If
If Text2。Text = "” Then '提示用户密码不能为空
MsgBox ”密码不能为空！”, ， ”登录提示信息:”
Text2.SetFocus
Exit Sub
End If
If Text3.Text = "” Then
MsgBox "请再次输入密码！", , ”登录提示信息："
Text3。SetFocus
Exit Sub
End If
If Text2。Text 〈> Text3。Text Then
MsgBox ”两次输入的密码不一致，请确认！"， ， ”登录提示信息：”
Text2.Text = "”
Text3.Text = ”"
Text2。SetFocus
Exit Sub
Else
Adodc1。Recordset.AddNew ’添加新用户
Adodc1.Recordset。Fields（"用户名") = Trim（Text1。Text)
Adodc1.Recordset.Fields(”密码”） = Trim（Text2.Text)
Adodc1。Recordset.Update
Dim X As Integer
X = MsgBox("成功添加新用户，是否要重新登录!”, vbYesNo + vbQuestion + vbDefaultButton1, ”提示信息！”)
If X = vbYes Then
Unload Me
Form3.Show
End If
'MsgBox （"成功添加新用户！”）
’Label3.Visible = False
'Text3.Visible = False
’Command1。Caption = "登录”
’Command2.Caption = ”退出"
End If
Frame1。Visible = False
Frame2.Visible = True
Text1.Text = "”
Text2.Text = ”'"
Text3.Text = ”"
’Form3。Show
End Sub
Private Sub Command2_Click（)
Frame1.Visible = False
Frame2。Visible = True
End Sub
Private Sub CXDL_Click（）
Form3.Show
'Unload Me
End Sub
Private Sub Exit_Click（)
End
Unload Form1
Unload Form2
Unload Form3
Unload Form4
Unload Form5
Unload Form6
Unload Form7
Unload Form8
End Sub
Private Sub Form_Load(）
TextUserName = Trim（Form1.Text1.Text）
Unload Form1
Frame1.Visible = False
Call InitGrid0
Me.Height = MDIForm1。Height — 1060
Me.Width = MDIForm1.Width — 560
Me。Top = MDIForm1。Top
Me。Left = MDIForm1。Left
End Sub
Private Sub GHCZ_Click（）
’Form2.Hide
Form8。Show
End Sub
Private Sub GHPMCX_Click（）
Frame2。Caption = ”归还信息”
Dim pm As String
Dim n As String
pm = InputBox（”产品名”, ”请输入", 0）
n = "select ＊ from 归还表 where 品名 = '" & pm & ”'"
Adodc2。CommandType = adCmdText
Adodc2.RecordSource = n
Adodc2.Refresh
Call InitGrid2
End Sub
Private Sub GHRCX_Click（）
Frame2。Caption = "归还信息"
Dim JCR As String
Dim n As String
JCR = InputBox(”归还人”， "请输入”， 0）
n = ”select ＊ from 归还表 where 归还人 = ’” & JCR ＆ "'”
Adodc2.CommandType = adCmdText
Adodc2。RecordSource = n
Adodc2.Refresh
Call InitGrid2
End Sub
Private Sub GHSJCX_Click(）
Frame2。Caption = ”归还信息"
Dim JCRQ As String
Dim n As String
JCRQ = InputBox("归还日期，格式为：月/日/年 如：12/1/2011", ”请输入”， 0)
n = "select ＊ from 归还表 where 归还日期 = ’" & JCRQ & ”'”
Adodc2.CommandType = adCmdText
Adodc2。RecordSource = n
Adodc2。Refresh
Call InitGrid2
End Sub
Private Sub GHXHCX_Click（)
Frame2.Caption = ”归还信息”
Dim XH As String
Dim n As String
XH = InputBox（"产品型号"， "请输入”, 0）
n = ”select * from 归还表 where 型号 = ’” ＆ XH ＆ ”’"
Adodc2。CommandType = adCmdText
Adodc2。RecordSource = n
Adodc2。Refresh
Call InitGrid2
End Sub
Private Sub GHZCX_Click（)
Frame2.Caption = "归还信息”
Dim ZB As String
ZB = ”select ＊ from 归还表 ”
Adodc2.CommandType = adCmdText
Adodc2。RecordSource = ZB
Adodc2.Refresh
Call InitGrid2
End Sub
Private Sub JCCZ_Click（)
’Form2。Hide
Form7.Show
End Sub
Private Sub JCHPMCHX_Click（）
Frame2。Caption = "借出信息”
Dim pm As String
Dim n As String
pm = InputBox（"产品名”, "请输入"， 0）
n = ”select * from 借出表 where 品名 = '” ＆ pm ＆ ”’"
Adodc2。CommandType = adCmdText
Adodc2。RecordSource = n
Adodc2。Refresh
Call InitGrid2
End Sub
Private Sub JCHXHCHX_Click（)
Frame2。Caption = ”借出信息"
Dim XH As String
Dim n As String
XH = InputBox（"产品型号”, "请输入", 0)
n = ”select ＊ from 借出表 where 型号 = '" & XH & "’”
Adodc2.CommandType = adCmdText
Adodc2.RecordSource = n
Adodc2。Refresh
Call InitGrid2
End Sub
Private Sub JCRCX_Click()
Frame2。Caption = "借出信息"
Dim JCR As String
Dim n As String
JCR = InputBox（"借出人”， "请输入"， 0)
n = ”select * from 借出表 where 借出人 = '" & JCR ＆ ”’”
Adodc2.CommandType = adCmdText
Adodc2。RecordSource = n
Adodc2。Refresh
Call InitGrid2
End Sub
Private Sub JCSHJCX_Click（）
Frame2.Caption = "借出信息”
Dim JCRQ As String
Dim n As String
JCRQ = InputBox（”借出日期，格式为：月/日/年 如：12/1/2011"， ”请输入", 0）
n = "select * from 借出表 where 借出日期 = ’” ＆ JCRQ ＆ ”’"
Adodc2。CommandType = adCmdText
Adodc2。RecordSource = n
Adodc2。Refresh
Call InitGrid2
End Sub
Private Sub JCZCX_Click()
Frame2。Caption = ”借出信息"
Dim ZB As String
ZB = "select ＊ from 借出表 ”
Adodc2.CommandType = adCmdText
Adodc2。RecordSource = ZB
Adodc2.Refresh
Call InitGrid2
End Sub
Private Sub JSHRCHX_Click（）
Frame2.Caption = "归还信息”
Dim JSHR As String
Dim n As String
JSHR = InputBox（”经手人”， ”请输入”, 0）
n = "select * from 归还表 where 经手人 = ’” ＆ JSHR ＆ ”'”
Adodc2.CommandType = adCmdText
Adodc2。RecordSource = n
Adodc2。Refresh
Call InitGrid2
End Sub
Private Sub JSHRCX_Click（)
Frame2。Caption = ”借出信息"
Dim JSHR As String
Dim n As String
JSHR = InputBox(”经手人”， "请输入”, 0）
n = "select * from 借出表 where 经手人 = '" ＆ JSHR & ”'"
Adodc2。CommandType = adCmdText
Adodc2。RecordSource = n
Adodc2。Refresh
Call InitGrid2
End Sub
Private Sub PMCX_Click()
Frame2.Caption = ”库存信息"
Dim pm As String
Dim n As String
pm = InputBox(”产品名”， "请输入"， 0)
n = "select * from 库存表 where 品名 = '” & pm & ”'"
Adodc2。CommandType = adCmdText
Adodc2。RecordSource = n
Adodc2.Refresh
Call InitGrid0
End Sub
Private Sub RKCZ_Click(）
’Form2。Hide
Form5。Show
End Sub
Private Sub RKJSHR_Click（)
Frame2。Caption = ”入库信息"
Dim JSHR As String
Dim n As String
JSHR = InputBox（"经手人”， "请输入", 0）
n = ”select * from 入库表 where 经手人 = '” & JSHR & ”’”
Adodc2.CommandType = adCmdText
Adodc2.RecordSource = n
Adodc2.Refresh
Call InitGrid1
End Sub
Private Sub RKPMCHX_Click（)
Frame2.Caption = "入库信息”
Dim pm As String
Dim n As String
pm = InputBox（"产品名”, ”请输入”， 0）
If Len(pm) > 0 Then
n = ”select * from 入库表 where 品名 = '” & pm ＆ ”’”
Adodc2.CommandType = adCmdText
Adodc2。RecordSource = n
Adodc2。Refresh
End If
Call InitGrid1
End Sub
Private Sub RKSHJ_Click()
Frame2.Caption = "入库信息"
Dim RKRQ As String
Dim n As String
RKRQ = InputBox("入库日期，格式为：月/日/年 如：12/1/2011”, ”请输入", 0)
n = ”select ＊ from 入库表 where 入库日期 = ’" & RKRQ & "’”
Adodc2.CommandType = adCmdText
Adodc2。RecordSource = n
Adodc2.Refresh
Call InitGrid1
End Sub
Private Sub RKXHCHX_Click（）
Frame2.Caption = "入库信息”
Dim XH As String
Dim n As String
XH = InputBox（”产品型号", "请输入", 0）
If Len(XH) > 0 Then
n = "select * from 入库表 where 型号 = ’” & XH & ”’”
Adodc2.CommandType = adCmdText
Adodc2.RecordSource = n
Adodc2。Refresh
End If
Call InitGrid1
End Sub
Private Sub RKZCX_Click（）
Frame2.Caption = "入库信息”
Dim ZB As String
ZB = "select ＊ from 入库表 "
Adodc2。CommandType = adCmdText
Adodc2.RecordSource = ZB
Adodc2。Refresh
Call InitGrid1
End Sub
Private Sub Timer1_Timer(）
If Label4。Left + Label4。Width > 0 Then ’当标签右边位置大于0时,标签向左移
Label4.Move Label4.Left - 80
Else