为什么不允许更新新记录

时间:2017-07-31 17:46:53

标签: vba ms-access access-vba

我正在尝试为员工创建一个表单,以便为约会输入整理时间。

以为我有它工作,直到同一个宠物在新的约会上预约,然后我得到Microsoft Visual Basic运行时错误3022,并且不会添加新条目。

我在哪里错过了这里发生的事情?

Private Sub cmdNew_Click()

' Error check for empty comboboxes
If IsNull(CmbPetName) = True Then
    MsgBox ("Pick A Pet For This Operation")
    Exit Sub
ElseIf IsNull(CmbPEmplye) = True Then
    MsgBox ("Pick A Prep Employee For This Operation")
    Exit Sub
ElseIf IsNull(CmbPTime) = True Then
    MsgBox ("Pick A Prep Time For This Operation")
    Exit Sub
ElseIf IsNull(CmbBEmplye) = True Then
    MsgBox ("Pick A Bath Employee For This Operation")
    Exit Sub
ElseIf IsNull(CmbBTime) = True Then
    MsgBox ("Pick A Bath Time For This Operation")
    Exit Sub
ElseIf IsNull(CmbDEmplye) = True Then
    MsgBox ("Pick A Dry Employee For This Operation")
    Exit Sub
ElseIf IsNull(CmbDTime) = True Then
    MsgBox ("Pick A Dry Time For This Operation")
    Exit Sub
ElseIf IsNull(CmbGEmplye) = True Then
    MsgBox ("Pick A Groom Employee For This Operation")
    Exit Sub
ElseIf IsNull(CmbGTime) = True Then
    MsgBox ("Pick A Groom Time For This Operation")
    Exit Sub
End If

'Set variables for error checking duplicates
Dim pid As String
Dim aptdate As Date
pid = CmbPetName.Column(2)
    'MsgBox (pid)
aptdate = txtAptDate.Value
    'MsgBox (aptdate)
Dim strCriteria As String

'Set Criteria for DCount()
strCriteria = "([PetID] = '" & pid & "') And ([ApptDate] = #" & aptdate & "#)"
    'MsgBox (strCriteria)

'Error checking for duplicates
If DCount("[PetID]", "[TimeLog]", strCriteria) > 0 Then
    MsgBox ("Record Already Exists")
    Exit Sub
End If

'Set variables to record entries
Dim rs As DAO.Recordset
Dim db As DAO.Database
Set db = CurrentDb
Set rs = db.OpenRecordset("TimeLog", dbOpenTable)

'Add entries to Table TimeLog
rs.AddNew
rs!PetID = CmbPetName.Value
rs!PetName = Me.CmbPetName.Column(0)
rs!ApptDate = txtAptDate.Value
rs!ptime = CmbPTime.Value
rs!PEmplyee = CmbPEmplye.Value
rs!btime = CmbBTime.Value
rs!BEmplyee = CmbBEmplye.Value
rs!dtime = CmbDTime.Value
rs!DEmplyee = CmbDEmplye.Value
rs!gtime = CmbGTime.Value
rs!GEmplyee = CmbGEmplye.Value

rs.Update

rs.Close
db.Close

Set rs = Nothing
Set db = Nothing

Me.CmbPetName = Null
Me.CmbPEmplye = Null
Me.CmbBEmplye = Null
Me.CmbDEmplye = Null
Me.CmbGEmplye = Null
Me.CmbPTime = Null
Me.CmbBTime = Null
Me.CmbDTime = Null
Me.CmbGTime = Null

End Sub

运行时发生在rs.update行上。

2 个答案:

答案 0 :(得分:1)

这张桌子上的主键是什么?从它的声音来看,你的主键可能只是宠物上的,而不是宠物约会日期的复合键。

答案 1 :(得分:0)

rs!PetID = CmbPetName.Value不能复制可能产生冲突的密钥吗?

相关问题