我正在尝试为员工创建一个表单,以便为约会输入整理时间。
以为我有它工作,直到同一个宠物在新的约会上预约,然后我得到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行上。
答案 0 :(得分:1)
这张桌子上的主键是什么?从它的声音来看,你的主键可能只是宠物上的,而不是宠物和约会日期的复合键。
答案 1 :(得分:0)
rs!PetID = CmbPetName.Value不能复制可能产生冲突的密钥吗?