Public Function Duplicate(ByVal strKey As String, ByVal strTable As String, _
ByVal lngID As Long) As Long
On Error GoTo Err_Duplicate
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim fld As DAO.Field
Dim varValue As Variant
Set db = CurrentDb
Set rs = db.OpenRecordset(strTable)
With rs
.AddNew
For Each fld In rs.Fields
If fld.Name <> strKey Then
varValue = DLookup("[" & fld.Name & "]", strTable, "[" & strKey & "] = " & lngID)
If Not IsNull(varValue) Then
fld = varValue
End If
Else
Duplicate = DMax("[" & strKey & "]", strTable) + 1
fld = Duplicate
End If
Next
.Update
.Close
End With
'Duplicate = True
Exit_Duplicate:
Set fld = Nothing
Set rs = Nothing
Set db = Nothing
Exit Function
Err_Duplicate:
Duplicate = False
Resume Exit_Duplicate
End Function
------------
Private Sub bDuplicateCurrentRecord_Click()
Dim newId As Long
Beep
newId = Duplicate("ID", "Daten", Me!ID)
Call Auswahl(newId)
MsgBox ("Der Datensatz wurde dupliziert und mit einer neuen ID gespeichert. Sie arbeiten nunmehr mit der Kopie und können diese ändern.")
End Sub