访问错误:无法在记录集中添加表'TableName'的记录联合键

时间:2016-06-29 18:15:13

标签: vba access-vba ms-access-2010

我有两个链接的表'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

0 个答案:

没有答案