ACCESS备件管理数据库分类出入库改进

需要解决的问题：
原本计划只针对设备专用备件进行入库登记，实际操作中，发现部门采购的所有物品都需要进行收货及入库登记。原来开发的模块无法实现新的需求。
解决方案：

1. 在后台数据库文件中新增一张通用备件库存表。 通过复制专用备件库存表的数据结构来实现。
2. 在出入库登记视窗内增加一个通用备件查询的子窗体（第三子窗体），此子窗体的尺寸、位置以及窗体是否可见属性设置成第二子窗体一样。
3. 在出入库登记视窗内增加两只复选框控件，一只的标签是专用备件（名称ChkZhuanyong），另外一只的标签是通用备件（名称ChkTongyong）。两只复选框为互锁的逻辑。当第二子窗体没有成为当前显示时，复选框ChkZhuanyong被选中则子窗体区域显示第一子窗体，复选框ChkTongyong被选中则子窗体区域显示第三子窗体。
4. 当第二子窗体为当前显示时，每更新一次按采购单号进行的查询，两只复选框都会被置成False。
5. 每次点击入库或出库操作时，系统提示需要选择正确的备件类型（专用或通用），以保证出入库操作时不能访问到正确的后台数据表。
   

Private Sub ChkTongyong_Click()
Me.ChkZhuanyong = False
If Me.查询_采购单及采购明细_子窗体.Visible = True Then
    Me.查询_K_通用备件列表_子窗体.Visible = False
Else
    Me.查询_K_通用备件列表_子窗体.Visible = True
End If
End Sub

Private Sub ChkZhuanyong_Click()
Me.查询_K_通用备件列表_子窗体.Visible = False
Me.ChkTongyong = False
End Sub

Private Sub CmdRuku_Click()
On Error GoTo Err_CmdRuku_Click
  Dim Rs1 As ADODB.Recordset
  Dim Rs2 As ADODB.Recordset
  Set Rs1 = New ADODB.Recordset
  Set Rs2 = New ADODB.Recordset
  Dim strTemp As String
  Dim strSQL As String
  Dim rsCnt As Integer
 
  If Me.品名 = "" Then
        MsgBox "执行入库前，请在品名文本框输入内容"
        Me.品名.SetFocus
        Exit Sub
  End If
  If Me.用途 = "" Then
        MsgBox "执行入库前，请在用途文本框输入内容"
        Me.用途.SetFocus
        Exit Sub
  End If
  If Me.数量 = "" Then
        MsgBox "执行入库前，请在数量文本框输入内容"
        Me.数量.SetFocus
        Exit Sub
  End If
  If Me.费用中心 = "" Then
        MsgBox "执行入库前，请在费用中心文本框选择内容"
        Me.费用中心.SetFocus
        Exit Sub
  End If
  If Me.单价 = "" Then
        MsgBox "执行入库前，请在单价文本框输入内容"
        Me.单价.SetFocus
        Exit Sub
  End If
  If Me.重要性等级 = "" Then
        MsgBox "执行入库前，请在重要性等级文本框选择内容"
        Me.重要性等级.SetFocus
        Exit Sub
  End If
  If Me.安全库存量 = "" Then
        MsgBox "执行入库前，请在安全库存量文本框输入内容"
        Me.安全库存量.SetFocus
        Exit Sub
  End If
  If Me.日期 = "" Then
        MsgBox "执行入库前，请在出入库日期文本框输入内容"
        Me.日期.SetFocus
        Exit Sub
  End If
  If Me.ChkTongyong = False And Me.ChkZhuanyong = False Then
        MsgBox "收货入库前请选择是专用备件还是通用备件", vbInformation, "重要提示"
        Me.ChkZhuanyong.SetFocus
        Exit Sub
  End If

  
  
  If MsgBox("请确认备件品名、规格和数量信息，并确认要执行入库吗？", vbInformation + vbYesNo, "重要提示") = vbNo Then Exit Sub
  
  '如果是从采购单列表中选择品名进行入库，则判断该采购单中被选中备件的收货日期字段是否有内容
  If blFromPR = True And Me.查询_采购单及采购明细_子窗体.Visible = True Then
    If strArray(5) <> "" Then
        If MsgBox("此备件已经于" & strArray(5) & "入库一次，还要再次入库吗？", vbInformation + vbYesNo, "重要提示") = vbNo Then
            Exit Sub
        End If
    End If
  End If
  
  If Me.ChkTongyong = True Then
    strTemp = "Select * From K_通用备件列表"   '勾选了通用备件的时候才把入库的备件登记到通用备件列表中
  Else
    strTemp = "Select * From K_专用备件清单"   '勾选了专用备件的时候才把入库的备件登记到专用备件清单中
  End If
    Rs1.Open strTemp, CurrentProject.Connection, adOpenKeyset, adLockOptimistic
    If Rs1.RecordCount = 0 Then
        Rs1.AddNew
        Rs1("品名") = Me.品名
        Rs1("规格") = Me.规格
        Rs1("品牌") = Me.品牌
        Rs1("数量") = Me.数量
        Rs1("单价") = Me.单价
        Rs1("总价") = Rs1("数量") * Rs1("单价")
        Rs1("用途") = Me.用途
        Rs1("费用中心") = Me.费用中心
        Rs1("重要性等级") = Me.重要性等级
        Rs1("安全库存量") = Me.安全库存量
        Rs1("最后入库日期") = Me.日期
        Rs1.Update
    Else
        Rs1.MoveFirst
        cunzai = False
        For i = 0 To Rs1.RecordCount - 1
            If Rs1("品名") = Me.品名 And Rs1("规格") = Me.规格 Then
                cunzai = True
                Rs1("数量") = Rs1("数量") + Me.数量
                Rs1("单价") = Me.单价
                Rs1("总价") = Rs1("数量") * Rs1("单价")
                Rs1("最后入库日期") = Me.日期
                Rs1.Update
                i = Rs1.RecordCount
            Else
                Rs1.MoveNext
            End If
        Next
        If cunzai = False Then
            Rs1.AddNew
            Rs1("品名") = Me.品名
            Rs1("规格") = Me.规格
            Rs1("品牌") = Me.品牌
            Rs1("数量") = Me.数量
            Rs1("单价") = Me.单价
            Rs1("总价") = Rs1("数量") * Rs1("单价")
            Rs1("用途") = Me.用途
            Rs1("费用中心") = Me.费用中心
            Rs1("重要性等级") = Me.重要性等级
            Rs1("安全库存量") = Me.安全库存量
            Rs1("最后入库日期") = Me.日期
            Rs1.Update
        End If
    End If
  
  '登记到备件入库登记表内
    strTemp = "Select * From K_备件入库登记"
    Rs2.Open strTemp, CurrentProject.Connection, adOpenKeyset, adLockOptimistic
    Rs2.AddNew
    Rs2("备件ID") = Rs1("备件ID")
    Rs2("品名") = Rs1("品名")
    Rs2("规格") = Rs1("规格")
    Rs2("品牌") = Rs1("品牌")
    Rs2("用途") = Rs1("用途")
    Rs2("费用中心") = Rs1("费用中心")
    Rs2("入库数量") = Me.数量
    Rs2("单价") = Rs1("单价")
    Rs2("入库日期") = Me.日期
    Rs2("记录者") = Me.记录者
    Rs2.Update
    
'更新采购单列表中收货人和收货日期字段内容
  Dim Rs3 As ADODB.Recordset
  Set Rs3 = New ADODB.Recordset
  Dim Xing As String
  Dim Ming As String
  Xing = Left(Me.记录者, 1)
  Ming = Mid(Me.记录者, 2)
  
  If blFromPR = True Then
    strTemp = "Select * From K_采购单列表"
    Rs3.Open strTemp, CurrentProject.Connection, adOpenKeyset, adLockOptimistic
    Rs3.MoveFirst
    If strArray(0) = "" Then
        MsgBox "没有从采购单列表中选中备件", vbInformation, "提示"
        Exit Sub
    End If
    For i = 0 To Rs3.RecordCount - 1
        If Rs3("采购ID") = strArray(8) Then
'            Rs3("收货人ID") = DLookup("[员工ID]", "K_员工列表", "[员工名]= '" & Ming & "'")
            Rs3("收货人ID") = DLookup("[员工ID]", "K_员工列表", "[员工名]= '" & Ming & "'" & "And [员工姓]='" & Xing & "'")
            Rs3("收货日期") = Me.日期
            i = Rs3.RecordCount
        Else
            Rs3.MoveNext
        End If
    Next
    Rs3.Update
  End If
  
  Rs1.Close
  Rs2.Close
  Rs3.Close
  Set Rs1 = Nothing
  Set Rs2 = Nothing
  Set Rs3 = Nothing
  
  MsgBox "收货入库操作已经完成！", vbInformation, "提示"
If Me.查询_采购单及采购明细_子窗体.Visible = True Then
        strSQL = "Select * From 查询_采购单及采购明细 Where 采购单号= '" & Me.TxtPRtitle & "' "
        Me.查询_采购单及采购明细_子窗体.Form.RecordSource = strSQL
  Else
        Call CmdQuery_Click
  End If

Exit_CmdRuku_Click:
    Exit Sub
Err_CmdRuku_Click:
    MsgBox Err.Description
    Resume Exit_CmdRuku_Click
End Sub