Обновление существующих записей и добавление новых записей в таблицу (MS Access VBA)

Question

Я не могу получить свой код для добавления новых записей и обновления существующих записей в моей таблице. У меня есть две таблицы; одна временная таблица (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

Спасибо

Answer 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