我有两个链接的表'tblPatients'和'tblDSA',两个继续形式'frmPatients'和'frmDSA'。当我通过'frmPatient'创建一个新患者时,我想在'frmDSA'中为该患者添加一条新记录而不关闭该表格。
在每条记录旁边的'frmPatients'上有一个按钮'SaveNewRecord',它执行以下操作:
(1)将新记录保存到'tblPatients'并过滤 (2)打开“frmDSA”以显示该患者的相关记录。
以下是过滤代码:
If Not Me.NewRecord Then
DoCmd.OpenForm "DSAfrm", _
WhereCondition:="LABCODE=" & Me.LABCODE
End If
以下是发生的事情:
弹出'DSAfrm'并尝试输入新记录后,我收到以下错误。“无法在记录集中添加表'TableName'的记录联合键”
新患者已保存为'tblPatients',但Access不允许我添加任何新记录。请帮忙!
以下是我用来保存新记录的代码:
Private Sub Command385_Click()
Dim db As DAO.Database
Dim PatientTable As DAO.Recordset
Dim DSAtable As DAO.Recordset2
Dim errMsg As String 'Where we will store error messages
Dim errData As Boolean 'Default = False if we have an error we will set it to True.
Dim i As Integer 'used as a counter in For..Next loops.
Dim x As Integer 'used as counter in For..Next loops.
Dim errorArray(0 To 3) As String 'Array to hold the error messages so we can 'use them if needed.
If Me.LABCODE.Value = "" Then
errorArray(0) = "Must Enter Labcode."
errData = True
End If
If Me.LastName.Value = 0 Then
errorArray(1) = "Must Enter Patient Number"
errData = True
End If
If Me.FirstName.Value = "" Then
errorArray(2) = "Must Enter Insurance Type"
errData = True
End If
If Me.MRN.Value = "" Then
errorArray(3) = "Must Enter Intake Nurse"
errData = True
End If
'MsgBox "errData = " & errData
If errData = True Then
i = 0
x = 0
For i = 0 To 3
If errorArray(i) <> "" Then
If x > 0 Then
errMsg = errMsg & vbNewLine & errorArray(i)
Else
errMsg = errorArray(i)
x = x + 1
End If
End If
Next i
MsgBox errMsg & vbNewLine & "Please try again."
errMsg = ""
Me.LABCODE.SetFocus
Exit Sub
End If
Set db = CurrentDb()
Set PatientTable = db.OpenRecordset("tblPatients")
With PatientTable
.AddNew
!LABCODE = Me.LABCODE.Value
!LastName = Me.LastName.Value
!FirstName = Me.FirstName.Value
!MRN = Me.MRN.Value
!MRNTwo = Me.MRN2.Value
Debug.Print Me.MRN.Value
'!CPI#2 = Me.MRN2.Value
!Kidney = Me.cbKidney.Value
!Heart = Me.cbHeart.Value
!Lung = Me.cbLung.Value
!Liver = Me.cbLiver.Value
!Pancreas = Me.cbPancreas.Value
!DateLogged = Format(Date, "MM/DD/YY")
.Update
End With
'End If
Set DSAtable = db.OpenRecordset("tblDSA")
With DSAtable
.AddNew
!LABCODE = Me.LABCODE.Value
.Update
End With
'Let the user know it worked.
MsgBox "This patient has been added successfully.", vbOKOnly
'If Not Me.NewRecord Then
DoCmd.OpenForm "DSAfrm", _
WhereCondition:="LABCODE=" & Me.LABCODE
'End If
End Sub