Private Sub cmdDuplicateRecord_Click()
'Дублирование записи формы + Копирование записей из её подчинённой формы
'Duplicatie van records van het huidige formulier samen met de gegevens van de ondergeschikte
'Duplicate form entry + Copy entries from its SubForm
'----------------------------------------------------------------
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 - RecordID field name
On Error GoTo cmdDuplicateRecord_Click_Err
Me.Dirty = False 'Сохранка! - huidige record opslaan - Saving the current form entry
n = Me.Recordset.Fields.Count - 1 'кол-во полей = Размерность массива - Matrix dimensie - Number of fields = Array size
ReDim v(n)
For i = 0 To n 'Текущие значения полей в массив - Put the current field values into an array
v(i) = Me.Recordset.Fields(i).Value
Next i
If IsNull(Me(sIDFieldName).Value) Then
'Nieuw item - Geen duplicatie! - New entry - Can't duplicate!
MsgBox "Запись новая - Нельзя дублироваить!", vbExclamation
GoTo cmdDuplicateRecord_Click_End
End If
'Remember the ID of the old record - to insert subordinate ...
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
Saving the record you just created
lRecIDNew = Me(sIDFieldName).Value 'ID новой записи - для вставки подчинённых _
Nieuw record-ID - om ondergeschikten in te voegen ...
'Копируем подчинённые записи - запросом на добавление ... _
Copying subordinate records with a Add Query ...
strSQL = "INSERT INTO TeamComposition ( TeamMember, MovementID ) " & _
"SELECT TeamMember, " & lRecIDNew & " AS RecIID " & _
"FROM TeamComposition " & _
"WHERE (MovementID = " & lRecID & ")"
CurrentDb.Execute strSQL 'исполняем
Me!Form1.Requery
'The data has been successfully copied! = Meesage:
MsgBox "Данные успешно скопированы!", vbOKOnly + vbInformation, "Information"
cmdDuplicateRecord_Click_End:
Exit Sub
cmdDuplicateRecord_Click_Err:
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure cmdDuplicateRecord_Click.", vbCritical, "Произошла ошибка!"
Err.Clear
Resume cmdDuplicateRecord_Click_End
End Sub