On Error GoTo errEnd
dbName = App.Path
If Right(dbName, 1) <> \dbName = dbName + \
STRSQL = \用户身份] from [Admin] where [用户ID]=\\
'打开数据库
Set userDB = DBEngine.Workspaces(0).OpenDatabase(dbName, False, True)
'检索用户,验证密码
Set userRD = userDB.OpenRecordset(STRSQL, dbOpenSnapshot)
If userRD.RecordCount > 0 Then '关闭数据库 userRD.Close
Set userRD = Nothing userDB.Close
Set userDB = Nothing
checkUserID = True
Screen.MousePointer = vbDefault Else
'关闭数据库 userRD.Close
Set userRD = Nothing userDB.Close
Set userDB = Nothing
Screen.MousePointer = vbDefault checkUserID = False End If
Exit Function
errEnd:
Screen.MousePointer = vbDefault
MsgBox Err.Description, vbOKOnly + vbExclamation, \修改密码\ Err.Clear '关闭数据库 userRD.Close
Set userRD = Nothing userDB.Close
Set userDB = Nothing End Function
模块名：CmdChgPass_Click
模块原型：Private Sub CmdChgPass_Click() 代码：
Private Sub CmdChgPass_Click() On Error GoTo errEnd
If TxtUserID.Text = \
MsgBox \请输入你的帐号！\更改密码\
TxtUserID.SetFocus Exit Sub End If
If TxtPasswd.Text = \
MsgBox \请输入你的旧密码！\更改密码\
TxtPasswd.SetFocus Exit Sub End If
If TxtNewPasswd.Text = \
MsgBox \请输入你的新密码！\更改密码\
TxtNewPasswd.SetFocus Exit Sub End If
If TxtNewPasswd.Text <> TxtNewPasswdC.Text Then
MsgBox \密码输入不一致，请重试！\更改密码\
TxtPasswd.Text = \ TxtNewPasswd.Text = \ TxtNewPasswdC.Text = \ TxtPasswd.SetFocus
Exit Sub End If
If checkUserID(TxtUserID.Text) Then
Adodc1.CommandType = adCmdText Adodc1.RecordSource = \* from [Admin] where [用户密码]=\& TxtPasswd.Text & \用户ID]=\
Adodc1.Refresh
If Adodc1.Recordset.RecordCount > 0 Then Adodc1.Recordset.MoveFirst
Adodc1.Recordset!用户密码 = TxtNewPasswd.Text Adodc1.Recordset.Update Else
MsgBox \用户密码验证错误！你无权修改密码！\vbExclamation, \密码错误\
TxtPasswd.Text = \ TxtNewPasswd.Text = \ TxtNewPasswdC.Text = \ Exit Sub End If
MsgBox \用户密码修改成功！请牢记！\\更改密码\
TxtPasswd.Text = \ TxtNewPasswd.Text = \ TxtNewPasswdC.Text = \Else
MsgBox \该用户不存在！无法修改密码！\vbOKOnly + vbExclamation, \更改密码\
TxtPasswd.Text = \ TxtNewPasswd.Text = \ TxtNewPasswdC.Text = \End If
Exit Sub
errEnd:
MsgBox Err.Description & vbCrLf & \更改密码失败！\vbExclamation, \操作数据库出错\End Sub
模块名：CmdRegMe_Click
模块原型：Private Sub CmdRegMe_Click() 代码：
Private Sub CmdRegMe_Click() On Error GoTo errEnd
If TxtCard.Text = \
MsgBox \请填写员工帐号！\创建员工帐号\
TxtCard.SetFocus Exit Sub End If
If TxtUName.Text = \
MsgBox \请填写员工的姓名！\创建员工帐号\
TxtUName.SetFocus Exit Sub End If
If ComboShenFen.Text = \请选择员工身份\Then
MsgBox \请选择员工的身份！\创建员工帐号\
ComboShenFen.SetFocus Exit Sub End If
If TxtUDanWei.Text = \无\
If TxtUDiZhi.Text = \
MsgBox \请填写员工的地址！\创建员工帐号\
TxtUDiZhi.SetFocus Exit Sub End If
If TxtUMail.Text = \无\
If TxtUDianHua.Text = \无\
If TxtUMemo.Text = \无\
If checkUserID(TxtCard.Text) Then
MsgBox \这个员工帐号已经被注册！请另选一个！\vbExclamation, \创建员工帐号\
TxtCard.SelStart = 0
TxtCard.SelLength = Len(TxtCard.Text) TxtCard.SetFocus Exit Sub End If
CmdRegMe.Enabled = False ‘开始一个事务 BeginTrans
Adodc1.CommandType = adCmdTable Adodc1.RecordSource = \员工表\Adodc1.Refresh
Adodc1.Recordset.AddNew
Adodc1.Recordset!员工帐号 = TxtCard.Text Adodc1.Recordset!姓名 = TxtUName.Text If OptionMan.Value Then
Adodc1.Recordset!性别 = \男\Else
Adodc1.Recordset!性别 = \女\End If
Adodc1.Recordset!地址 = TxtUDiZhi.Text Adodc1.Recordset!手机 = TxtUDanWei.Text Adodc1.Recordset!电子邮件 = TxtUMail.Text Adodc1.Recordset!电话 = TxtUDianHua.Text Adodc1.Recordset!人生格言 = TxtUMemo.Text Adodc1.Recordset!创建日期 = Now() Adodc1.Recordset.Update
Adodc1.CommandType = adCmdTable Adodc1.RecordSource = \Adodc1.Refresh
Adodc1.Recordset.AddNew
Adodc1.Recordset!用户ID = TxtCard.Text Adodc1.Recordset!用户密码 = TxtCard.Text
Adodc1.Recordset!用户身份 = ComboShenFen.Text Adodc1.Recordset.Update
CommitTrans
MsgBox \恭喜你，注册成功！\员工的帐号和密码就是你填写的员工帐号！\& vbCrLf & \请员工自行修改密码或立即修改密码。\vbOKOnly + vbQuestion, \注册成功\
TxtCard.Text = \TxtUName.Text = \TxtUDanWei.Text = \TxtUDiZhi.Text = \TxtUMail.Text = \TxtUDianHua.Text = \TxtUMemo.Text = \
CmdRegMe.Enabled = True
Exit Sub
errEnd:
Rollback MsgBox \注册失败，操作数据库发生错误！\vbOKOnly + vbExclamation, \注册失败\
CmdRegMe.Enabled = True End Sub
模块名：GetJinJia
模块原型：Public Function GetJinJia(bianHao As String) As String 代码：
Public Function GetJinJia(bianHao As String) As String On Error GoTo errEnd
Adodc1.CommandType = adCmdText
Adodc1.RecordSource = \单价] from [进书记录] where [图书编号]=\
Adodc1.Refresh
If Adodc1.Recordset.RecordCount > 0 Then Adodc1.Recordset.MoveFirst
GetJinJia = Adodc1.Recordset!单价 & \Else
MsgBox \数据丢失，清重试！\办理退货\
GetJinJia = \ Exit Function End If
Exit Function errEnd:
MsgBox \找不到该品种的进价！\检索数据库出错\
GetJinJia = \End Function
模块名：CmdTH_Click
模块原型：Private Sub CmdTH_Click() 代码：
Private Sub CmdTH_Click() On Error GoTo errEnd Dim QD As Integer
If TxtShuLiang.Text = \
MsgBox \请填写退货的数量.\办理退货\
TxtShuLiang.SetFocus Exit Sub End If
Adodc1.CommandType = adCmdText
Adodc1.RecordSource = \图书编号]=\TuShuBianHao & \
Adodc1.Refresh
If Adodc1.Recordset.RecordCount = 0 Then
MsgBox \数据丢失，清重试！\办理退货\
Exit Sub End If
Adodc1.Recordset.MoveFirst
If Adodc1.Recordset!库存量 - CInt(TxtShuLiang.Text) < 0 Then MsgBox \库存不足，没有足够的图书可以退回！\vbExclamation, \库存不足\
TxtShuLiang.SetFocus
TxtShuLiang.SelStart = 0
TxtShuLiang.SelLength = Len(TxtShuLiang.Text) Exit Sub End If
If TxtJinJia.Text = \
MsgBox \图书进价信息丢失，无法完成退货操作！\vbExclamation, \办理退货\
TxtShuLiang.SetFocus Exit Sub End If
If TxtJinE.Text = \
MsgBox \请填写退货金额.\办理退货\ TxtJinE.SetFocus Exit Sub End If
If TxtYuanYin.Text = \
MsgBox \请填写退货原因.\办理退货\ TxtYuanYin.SetFocus Exit Sub End If
If TxtMemo.Text = \无\
QD = MsgBox(\确定入帐吗?\确认入帐\If QD = vbCancel Then 'Unload Me Exit Sub End If
CmdTH.Enabled = False
Screen.MousePointer = 11
BeginTrans
Adodc1.CommandType = adCmdTable Adodc1.RecordSource = \退货记录\Adodc1.Refresh
Adodc1.Recordset.AddNew
Adodc1.Recordset!供应商编号 = GongYingShangID Adodc1.Recordset!图书编号 = TuShuBianHao Adodc1.Recordset!进价 = TxtJinJia.Text
Adodc1.Recordset!退货数量 = CInt(TxtShuLiang.Text) Adodc1.Recordset!金额 = TxtJinE.Text
Adodc1.Recordset!退货原因 = TxtYuanYin.Text Adodc1.Recordset!退货日期 = Now() Adodc1.Recordset!备注 = TxtMemo.Text Adodc1.Recordset.Update
Adodc1.CommandType = adCmdText
Adodc1.RecordSource = \图书编号]=\TuShuBianHao & \
Adodc1.Refresh
If Adodc1.Recordset.RecordCount = 0 Then Rollback
Screen.MousePointer = vbDefault
MsgBox \数据丢失，清重试！\办理退货\
CmdTH.Enabled = True Exit Sub End If
Adodc1.Recordset.MoveFirst
Adodc1.Recordset!库存量 = Adodc1.Recordset!库存量 - CInt(TxtShuLiang.Text)
Adodc1.Recordset.Update
CommitTrans
Screen.MousePointer = vbDefault
MsgBox \本次退货操作成功!\操作成功\Unload Me
Exit Sub errEnd:
Rollback
Screen.MousePointer = vbDefault
MsgBox \更新数据库失败!无法完成退货操作!\vbExclamation, \更新失败\
CmdTH.Enabled = True End Sub
模块名：CmdSaveContinue_Click
模块原型：Private Sub CmdSaveContinue_Click() 代码：
Private Sub CmdSaveContinue_Click() On Error GoTo errEnd
If TxtBianHao.Text = \
MsgBox \请输入供应商编号！\供应商登记\
TxtBianHao.SetFocus Exit Sub End If
If TxtDanWei.Text = \
MsgBox \请输入单位名称！\供应商登记\
TxtDanWei.SetFocus Exit Sub End If
If TxtDiZhi.Text = \
MsgBox \请输入供应商联系地址！\供应商登记\
TxtDiZhi.SetFocus Exit Sub End If