VBA Tipp: Datensatz duplizieren

Aus DBWiki
Wechseln zu: Navigation, Suche

Aufgabenstellung

Ich möchte einen Datensatz duplizieren, d.h. eine Kopie eines Datensatzes erstellen.

Man sollte dabei berücksichtigen, dass das unkontrollierte Duplizieren von Daten in einer Datenbank zu unerwünschten Redundanzen führen kann.

Lösung 1

Das geht mit folgender Funktion, die in einem allgemeinen (globalen) Modul gespeichert, und in einem Formular aufgerufen wird.

Argumente der Funktion:

  • Tabellenname: Name der Tabelle
  • Schluesselfeldname: Name des Schlüsselfeldes (AutoWert-Feld) in der Tabelle
  • AktuellerSchluesselwert: Wert aus dem Schlüsselfeld des Datensatzes, der dupliziert werden soll

Falls der Name der Tabelle oder des Schlüsselfeldes Sonderzeichen enthält, muss der Name in eckige Klammern eingeschlossen werden.

Public Function DatensatzDuplizieren(Tabellenname As String, _
                                     Schluesselfeldname As String, _
                                     AktuellerSchluesselwert As Variant) As Long
 
   ' Quelle: http://www.dbwiki.net/
 
   Dim fld     As DAO.Field
   Dim rs      As DAO.Recordset
   Dim rsneu   As DAO.Recordset
   Dim strSQL  As String
 
   If IsNull(AktuellerSchluesselwert) Then
      Err.Raise 2046, , "Der Befehl oder die Aktion 'Kopieren' ist zurzeit nicht verfügbar."
   ElseIf Not IsNumeric(AktuellerSchluesselwert) Then
      Err.Raise 13
   End If
 
   strSQL = "SELECT * FROM " & Tabellenname & _
            " WHERE " & Schluesselfeldname & " = " & AktuellerSchluesselwert
 
   ' ggf. eckige Klammern entfernen
   Tabellenname = Replace(Tabellenname, "[", "")
   Tabellenname = Replace(Tabellenname, "]", "")
   Schluesselfeldname = Replace(Schluesselfeldname, "[", "")
   Schluesselfeldname = Replace(Schluesselfeldname, "]", "")
 
   With CurrentDb
     Set rs = .OpenRecordset(strSQL, dbOpenSnapshot)
     Set rsneu = .OpenRecordset(Tabellenname, dbOpenDynaset)
   End With
 
   If Not rs.EOF Then
      rsneu.AddNew
 
      'Neuen Schlüsselwert als Rückgabewert setzen
      DatensatzDuplizieren = rsneu(Schluesselfeldname)
 
      For Each fld In rs.Fields
         If fld.Name <> Schluesselfeldname Then
            rsneu(fld.Name) = fld.Value
         End If
      Next
      rsneu.Update
   End If
 
   rs.Close
   rsneu.Close
 
End Function

Aufruf

 Dim lngret As Long
 
 ' Die ID des neuen Datensatzes als Rückgabewert der Funktion speichern
 lngret = DatensatzDuplizieren("EineTabelle", "ID", Me!iD)
 
 If lngret Then
 
    ' Duplizierten Datensatz sichtbar machen
    Me.Requery
 
    ' Fokus auf den duplizierten Datensatz setzen
    With Me.RecordsetClone
       .FindFirst "ID = " & lngret
       Me.Bookmark = .Bookmark
    End With
 
 End If

Lösung 2

Folgenden Code für das "Datensatz duplizieren" kann man vom Access-Schaltflächenassistenten erstellen lassen.

Private Sub EineSchaltfläche_Click()
 
   On Error GoTo Err_EineSchaltfläche_Click
 
   DoCmd.RunCommand acCmdSelectRecord
   DoCmd.RunCommand acCmdCopy
   DoCmd.RunCommand acCmdRecordsGoToNew
   DoCmd.RunCommand acCmdSelectRecord
   DoCmd.RunCommand acCmdPaste
 
Exit_EineSchaltfläche_Click:
   Exit Sub
 
Err_EineSchaltfläche_Click:
   MsgBox Err.Description
   Resume Exit_EineSchaltfläche_Click
 
End Sub