|
|
Дублирование записи в форме
Private Sub cmdDuplicateRecord_Click()
Dim i As Integer, n As Integer, v() As Variant
Dim lRecID As Long, lRecIDNew As Long
Dim strSQL As String
Const sIDFieldName$ = "ID"
On Error GoTo cmdDuplicateRecord_Click_Err
Me.Dirty = False
n = Me.Recordset.Fields.Count - 1
ReDim v(n)
For i = 0 To n
v(i) = Me.Recordset.Fields(i).Value
Next i
If IsNull(Me(sIDFieldName).Value) Then
MsgBox "Запись новая - Нельзя дублироваить!", vbExclamation
GoTo cmdDuplicateRecord_Click_End
End If
lRecID = Me(sIDFieldName).Value
Me.Recordset.AddNew
For i = 0 To n
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
lRecIDNew = Me(sIDFieldName).Value
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
|
|