Vorab:
Sicherlich müssen wir nicht über die Unsäglichkeiten von Duplizieren von Datensätzen sprechen,
allerdings gibt es ja auch die Situation wo Daten, hier gemäß Standards über mehrere Tabellen verteilt, als Vorlage für neue Einträge dienen.
Situation:
Nun müssen natürlich ich die (mit dem Datensatz) verbundenen Daten aus den Sub-Tabellen auch zur Vorlage dupliziert mit dem neuen Datensatz verbunden werden.
Ansatz:
Eine Funktion bekommt den Tabellennamen, und die Schlüsselfelder übermittelt, kurz: Welche Datensätze aus der Subtabelle ausgelesen werden müssen (ID des kopierten Datensatzes der Haupttabelle) und welche ID der neue Datensatz in der Haupttabelle hat.
Dann werden alle Felder "kopiert", bis auf das Feld mit dem ID des Datensatzes aus der Haupttabelle, dieses bekommt ja, zur korrekten Zuordnung, die ID des neuen Datensatzes der Haupttabelle
Über SQL erfolgt das Auslesen der passenden Datensätze aus der Subtabelle
strSQL = "SELECT * FROM [tb_Sub] WHERE ((([tb_Sub].[ID_Haupt]) = " & ID & "));"
Problem:
Der Befehl "update" (NeuRS.Update) -also das Speichern des neuen Datensatzes- funktioniert nicht.
Angeblich würde dies zu einem doppelten Index führen, obwohl nur das Primärschlüsselfeld einen indiziert ist und von meiner Routine gar nicht per Code "belegt" wird.
Wo liegt hier der Fehler?
Ich fasse den Code mal auf das wesentliche zusammen:
Dim fld As DAO.Field
Dim strSQL As String
Dim rs As DAO.Recordset
Dim dbs As DAO.Database
Set dbs = CurrentDb
ID = AktuellerSchluesselwert
ID_Neu = DublettenSchluesselwert
Dim lngStore As Long
Dim NeuRS As DAO.Recordset
With CurrentDb
Set rs = .OpenRecordset(strSQL, dbOpenSnapshot)
Set NeuRS = .OpenRecordset("tb_Sub", dbOpenDynaset)
End With
If Not rs.EOF Then
NeuRS.AddNew
'Neuen Schlüsselwert als Rückgabewert setzen
' ZutatenundAblaufDuplizieren = rsneu(RS_ID)
For Each fld In rs.Fields
If fld.Name <> Schluesselfeldname Then
' On Error Resume Next
If fld.Name = "ID_Haupt" Then
NeuRS(fld.Name) = DublettenSchluesselwert
Else
NeuRS(fld.Name) = fld.Value
End If
End If
Next
NeuRS.Update
End If
rs.Close
NeuRS.Close
Problem ignoriert und über Alternative gelöst. Anstelle des direkten Schreibens der Feldwerte in VBA, habe ich einen SQL-String ausführen lassen.
Obwohl alles gleich: Das funktioniert.
NEUString_SQL = "INSERT INTO ...Felder und Werte..."
....
CurrentDb.Execute NEUString_SQL
rs.MoveNext