VBA, MS Access MS Access в примерах

Дублирование записи в форме

Private Sub cmdDuplicateRecord_Click()
'Дублирование записи + Копирование записей из подчинённой формы
'Duplicatie van records van het huidige formulier samen _
    met de gegevens van de ondergeschikte
'----------------------------------------------------------------
Dim i As Integer, n As Integer, v() As Variant
Dim lRecID As Long, lRecIDNew As Long
Dim strSQL As String
Const sIDFieldName$ = "ID" 'Название поля кода записи - sleutel veld naam
 
On Error GoTo cmdDuplicateRecord_Click_Err
    
    Me.Dirty = False 'Сохранка! - huidige record opslaan
    
    n = Me.Recordset.Fields.Count - 1 'кол-во полей = Размерность массива - Matrix dimensie
    ReDim v(n)
    
    For i = 0 To n                    'Старые значения в массив (сколько бы не было полей)
        v(i) = Me.Recordset.Fields(i).Value
    Next i
    
    If IsNull(Me(sIDFieldName).Value) Then
        'Nieuw item - Geen duplicatie!
        MsgBox "Запись новая - Нельзя дублироваить!", vbExclamation
        GoTo cmdDuplicateRecord_Click_End
    End If
    lRecID = Me(sIDFieldName).Value 'Запоминаем ID старой записи - для вставки подчинённых ...
    
'Добаление новой записи - Een nieuw record toevoegen :
    Me.Recordset.AddNew 'На новую запись - ga naar een nieuw record
    For i = 0 To n  'Старые значения из массива переносим в поля новой записи (кроме ID)
        If Not Me.Recordset.Fields(i).Name = sIDFieldName Then
            If Not IsEmpty(v(i)) Then Me.Recordset.Fields(i).Value = v(i)
        End If
    Next i
    Me.Recordset.Update 'Сохранение созданой записи - _
        Als u het gemaakte record opslaat, moet u ondergeschikten toevoegen
    
    lRecIDNew = Me(sIDFieldName).Value 'ID новой записи - для вставки подчинённых _
        Nieuw record-ID - om ondergeschikten in te voegen  ...
    
'Ко-о-о-о-пируем подчинённые записи  - запросом на добавление ...
    strSQL = "INSERT INTO TeamComposition ( TeamMember, MovementID ) " & _
        "SELECT TeamMember, " & lRecIDNew & " AS RecIID " & _
        "FROM TeamComposition " & _
        "WHERE (MovementID = " & lRecID & ")"
    CurrentDb.Execute strSQL 'исполняем
    Me!Form1.Requery
    
    MsgBox "Данные успешно скопированы!", vbOKOnly + vbInformation, "Информация"
 
cmdDuplicateRecord_Click_End:
    On Error GoTo 0
    Exit Sub
 
cmdDuplicateRecord_Click_Err:
    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure cmdDuplicateRecord_Click.", vbCritical, "Произошла ошибка!"
    Err.Clear
    Resume cmdDuplicateRecord_Click_End
 
End Sub

Назад ToTop
L.E. 31.01.2021
Рейтинг@Mail.ru