用于记录列表框中新记录的访问命令(如果尚未存在)

时间:2017-07-12 15:38:27

标签: sql vba ms-access

我在我的工作中使用MS Access 2013,并且被要求建立一个可以跟踪员工培训的数据库。目前我有一个表格,他们可以选择部门和他们正在进行的培训,以及当前日期。根据部门,他们可以从列表框中选择参加该培训课程的员工。

我已经能够使用更新查询来使用此代码更新员工培训完成日期的当前记录

Private Sub cmdDocument_Click()
    Dim Q As QueryDef, DB As Database
    Dim Criteria As Variant
    Dim ctl As Control
    Dim Itm As Variant

    Set ctl = Me![lstEmployeeNames]

    For Each Itm In ctl.ItemsSelected
        If Len(Criteria) = 0 Then
            Criteria = Chr(32) & ctl.ItemData(Itm) & Chr(32)
        Else
            Criteria = Criteria & "," & Chr(32) & ctl.ItemData(Itm) & Chr(32)
        End If
    Next Itm

    If Len(Criteria) = 0 Then
        Itm = MsgBox("You must select Employee Name(s) in the List!", 0, _
                     "No Selection Made")
        Exit Sub
    End If

    Set DB = CurrentDb()
    Set Q = DB.QueryDefs("qRecord_CleanUp")
    Q.SQL = "UPDATE tblTraining Set [Date Completed] = " _ 
            & " Forms![frmTraining]![sfrmTraining].Form![txtDate] " _
            & " WHERE (((tblTraining.EmployeeID) IN (" & Criteria & "))" _
            & " AND ((tblTraining.TrainingID)=" _
            & "      Forms![frmTraining]![sfrmTraining].Form![cboTraining]));"
    Q.Close

    DoCmd.OpenQuery "qRecord_CleanUp"

End Sub

但问题是我无法添加新记录。如果员工过去已经完成了培训,我可以更新当前记录,但如果是员工的第一次培训,我就无法弄清楚如何为该员工添加新记录。我试图提出一个附加查询来实现这一目标,但是无法使用员工列表框(绑定到 EmployeeID )使其正常工作。

如果有人可以提供帮助,我会非常感激。提前谢谢。

3 个答案:

答案 0 :(得分:0)

使用记录集可以轻松实现。请在此处阅读:https://msdn.microsoft.com/en-us/library/office/ff197799.aspx

以下代码是一个示例,您需要做一些改进:

Private Sub cmdDocument_Click()
Dim Q As QueryDef, DB As Database
Dim Criteria As Variant
Dim ctl As Control
Dim Itm As Variant
Dim rs As DAO.Recordset

Set ctl = Me![lstEmployeeNames]
'Set the recordset, and move last to load the entire set
Set rs = CurrentDb.OpenRecordset("tblTraining")
rs.MoveLast
rs.Edit
For Each Itm In ctl.ItemsSelected
    'Look for the current employee
    rs.FindFirst "EmployeeID = &Chr(32) & ctl.ItemData(Itm) & Chr(32)"
    If Not rs.NoMatch Then
        If Len(Criteria) = 0 Then
            Criteria = Chr(32) & ctl.ItemData(Itm) & Chr(32)
        Else
            Criteria = Criteria & "," & Chr(32) & ctl.ItemData(Itm) & Chr(32)
        End If
    Else
        rs.AddNew
        rs.Fields("EmployeeID") = ctl.ItemData(Itm)
        rs.Fields("Date Completed") = txtDate
        rs.Fields("TrainingID") = cboTraining
        rs.Update
    End If
Next Itm
If Len(Criteria) = 0 Then
    Itm = MsgBox("You must select Employee Name(s) in the List!", 0, "No Selection Made")
    Exit Sub
End If

Set DB = CurrentDb()
Set Q = DB.QueryDefs("qRecord_CleanUp")
Q.SQL = "Update tblTraining Set [Date Completed] = Forms![frmTraining]![sfrmTraining].Form![txtDate]  WHERE (((tblTraining.EmployeeID) IN (" & Criteria & ")) AND ((tblTraining.TrainingID)=Forms![frmTraining]![sfrmTraining].Form![cboTraining]));"
Q.Close

DoCmd.OpenQuery "qRecord_CleanUp"

End Sub

我将现有代码用于找到的记录,对它们使用记录集会更好(而不是那么难)。此外,您的"如果没有人被选中"现在,代码将在不需要时触发。

答案 1 :(得分:0)

这是一个数据库设计问题,而不是编程问题。您不应该需要任何追加或更新查询。 MS Access表单应该处理该数据功能,即通过GUI编辑/添加/删除操作。

考虑以下设置:

  1. 添加一个新的连接表,例如 EmployeeTrainings ,其中包含用于相关表的外键ID, Employees Trainings ,用于维护一对多与他们两人的关系。还要在此表中添加 DateCompleted 等培训会话级别详细信息。
  2. 创建一个单项或多项表单,其recordource是这个新表。
  3. 在控件来源为 EmployeeID TrainingID 的表单上添加列表框或组合框。
  4. 从那里,用户可以在此表单上导航到新记录或现有记录,从列表框中选择所需的员工培训。如果需要更新,搜索或导航到该记录并在表单上进行编辑。如果需要添加,请转到空行(用于连续表单)或页面(用于单个表单)并开始输入所需数据。这样,您还可以维护培训历史记录,而不是持续更新相同的员工行。当然,查询只需要连接相关ID的表格。

答案 2 :(得分:0)

经过一段时间的努力,我得到了它的工作,这是最后的代码

Private Sub cmdDocument_Click()
Dim Q As QueryDef, DB As Database
Dim Criteria As Variant
Dim ctl As Control
Dim Itm As Variant
Dim rs As DAO.Recordset

Set ctl = Me![lstEmployeeNames]

Set rs = CurrentDb.OpenRecordset("tblTraining", dbOpenDynaset)
rs.MoveLast
rs.Edit
For Each Itm In ctl.ItemsSelected
    If Len(Criteria) = 0 Then
        Criteria = Chr(32) & ctl.ItemData(Itm) & Chr(32)
    Else
        Criteria = Criteria & "," & Chr(32) & ctl.ItemData(Itm) & Chr(32)
    End If
    If Len(Criteria) = 0 Then
        Itm = MsgBox("You must select Employee Name(s) in the List!", 0, "No Selection Made")
        Exit Sub
    End If

    rs.FindFirst "[EmployeeID] = " & ctl.ItemData(Itm) & " And [TrainingID] = " & Me![cboTraining]

        If Not rs.NoMatch Then
            Set DB = CurrentDb()
            Set Q = DB.QueryDefs("qRecord_CleanUp")
            Q.SQL = "Update tblTraining Set [Date Completed] = Forms![frmTraining]![sfrmTraining].Form![txtDate]  WHERE (((tblTraining.EmployeeID) IN (" & Criteria & ")) AND ((tblTraining.TrainingID)=Forms![frmTraining]![sfrmTraining].Form![cboTraining]));"
            Q.Close
        Else
            rs.AddNew
            rs.Fields("EmployeeID") = ctl.ItemData(Itm)
            rs.Fields("Date Completed") = txtDate
            rs.Fields("TrainingID") = cboTraining
            rs.Fields("Department") = txtDepartment
            rs.Update
        End If
Next Itm

DoCmd.SetWarnings (False)
DoCmd.OpenQuery "qRecord_CleanUp"

End Sub