更新现有记录并在表中添加新记录(MS Access VBA)

时间:2018-04-26 10:50:34

标签: vba ms-access

我无法获取我的代码来添加新记录并更新我所拥有的表中的现有记录。我有两张桌子;一个临时表(tblTempData)和另一个表(tblCommon)。我希望代码检查是否存在记录,然后更新列和&如果记录是新的,则添加新记录。当我运行代码时,tblCommon为空。我不知道哪个部分是错的。将感谢您的指导和建议。

以下是我的代码:

    Dim rsTemp As DAO.Recordset
    Dim rsCommon As DAO.Recordset

    Dim id1 As String
    Dim id2 As String

    Set rsTemp = CurrentDb.OpenRecordset("SELECT * FROM tblTempData", dbOpenDynaset)
    Set rsCommon = CurrentDb.OpenRecordset("SELECT * FROM tblCommon", dbOpenDynaset)

    rsTemp.MoveFirst
        id1 = rsTemp![Item ID]
    rsTemp.MoveNext

    Do Until rsTemp.EOF
        id2 = rsTemp![Item ID]
        If id1 = id2 Then
            With rsCommon
                If .RecordCount = 0 Then
                    .AddNew
                        ![Item Description] = rsTemp![Item Description]
                        ![Material Number] = rsTemp![Material Number]
                        ![User] = rsTemp![User]
                        ![Supplier] = rsTemp![Supplier]
                        ![Current Status] = rsTemp![Current Status]
                        ![Remarks] = rsTemp![Remarks]
                        ![Item ID] = id2
                    .Update
                    .Close
                Else
                    .FindFirst "[Item ID] = '" & id2 & "'"
                    If .NoMatch Then
                        .AddNew
                            ![Item Description] = rsTemp![Item Description]
                            ![Material Number] = rsTemp![Material Number]
                            ![User] = rsTemp![User]
                            ![Supplier] = rsTemp![Supplier]
                            ![Current Status] = rsTemp![Current Status]
                            ![Remarks] = rsTemp![Remarks]
                            ![Item ID] = id1
                        .Update
                        .Close
                    Else
                        .Edit
                            ![Item Description] = rsTemp![Item Description]
                            ![Material Number] = rsTemp![Material Number]
                            ![User] = rsTemp![User]
                            ![Supplier] = rsTemp![Supplier]
                            ![Current Status] = rsTemp![Current Status]
                            ![Remarks] = rsTemp![Remarks]
                            ![Item ID] = id2
                        .Update
                        .Close
                    End If
                End If
            End With
        Else
            Exit Sub
        End If
        id1 = id2
        rsTemp.MoveNext
    Loop
    Set rsTemp = Nothing
Else
    Exit Sub
End If

由于

1 个答案:

答案 0 :(得分:1)

另一种方法。

尝试通过为每项任务Exists()Add()Update()创建帮助函数来细分代码。阅读和维护代码会更容易。

  • 第一种方法检查记录是否存在。
  • 第二次更新记录。
  • 第三个添加记录。
Option Explicit

Private rsCommon As DAO.Recordset

Public Sub UpdateExistingRecords()
    On Error GoTo ErrTrap

    Dim rs As DAO.Recordset
    Set rs = CurrentDb().OpenRecordset("SELECT * FROM tblTempData", dbOpenSnapshot)
    Set rsCommon = CurrentDb().OpenRecordset("SELECT * FROM tblCommon", dbOpenDynaset)

    Dim idx As Long
    For idx = 1 To rs.RecordCount
        If ExistsInCommon(rs![Item ID]) Then
            If Not Update(rs) Then
                MsgBox "Failed to update.", vbExclamation
                GoTo Leave
            End If
        Else
            If Not Add(rs) Then
                MsgBox "Failed to add.", vbExclamation
                GoTo Leave
            End If
        End If
        rs.MoveNext
    Next

Leave:
    If Not rs Is Nothing Then rs.Close
    If Not rsCommon Is Nothing Then rsCommon.Close
    Set rs = Nothing
    Set rsCommon = Nothing
    Exit Sub

ErrTrap:
    MsgBox Err.Description, vbCritical
    Resume Leave
End Sub
' Exists - 'Assumes Id is String
Private Function ExistsInCommon(ByVal Id As String)
    ExistsInCommon = DCount("*", "tblCommon", "[Item ID] = '" & Id & "'") > 0   
End Function
' Update
Private Function Update(rs As DAO.Recordset) As Boolean
    With rsCommon
        .FindFirst "[Item ID] = '" & rs![Item ID] & "'"
        If .NoMatch Then Exit Function
        .Edit
        ![Item Description] = rs![Item Description]
        ![Material Number] = rs![Material Number]
        ![User] = rs![User]
        ![Supplier] = rs![Supplier]
        ![Current Status] = rs![Current Status]
        ![Remarks] = rs![Remarks]
        .Update
        .MoveFirst
    End With
    Update = True
End Function
'Add
Private Function Add(rs As DAO.Recordset) As Boolean
    With rsCommon
        .AddNew
        ![Item Description] = rs![Item Description]
        ![Material Number] = rs![Material Number]
        ![User] = rs![User]
        ![Supplier] = rs![Supplier]
        ![Current Status] = rs![Current Status]
        ![Remarks] = rs![Remarks]
        ![Item ID] = rs![Item ID]
        .Update
    End With
    Add = True
End Function
相关问题