Versehentlich Endlosschlaufe erstellt

[Minotauros]

Guten Tag

Ich möchte durch ein Recordset "loopen" und dabei jeden Datensatz duplizieren und dann ein paar der Felder der neuen Records anpassen. Für jeden Original-Datensatz wird zudem noch ein Record in einem anderen Recordset hinzugefügt.

Dafür habe ich einen (meiner Meinung nach eleganten) Code gefunden:

Code [Auswählen] Erweitern

sqlSource = "SELECT PositionID, Pos, Objekt_F, Menge, Einheit_F, Position_F, Liste_F " & _
                "FROM tblListe INNER JOIN (tblPosition INNER JOIN tblMenge ON tblPosition.PositionID = tblMenge.Position_F) ON tblListe.ListeID = tblPosition.Liste_F " & _
                "WHERE tblListe.Dokument_F= " & Me.cboLieferscheine & ";"
        Set rstSource = dbsCurrentDB.OpenRecordset(sqlSource, dbOpenDynaset)
        Set rstNew = rstSource.Clone
        Set rstPreis = dbsCurrentDB.OpenRecordset("tblPreis", dbOpenDynaset, dbAppendOnly)
        With rstSource
            Do Until .EOF           'Durch Quelle iterieren
                With rstNew
                    .AddNew
                    For Each fld In rstSource.Fields        'Alle bestehenden Felder kopieren
                        Select Case fld.Name
                            Case "PositionID"
                            Case "Position_F"
                                !Position_F = !PositionID
                            Case "Liste_F"
                                !Liste_F = Me.ListeID
                            Case Else
                                .Fields(fld.Name).Value = fld.Value
                        End Select
                    Next
                    .Update
                    .Bookmark = .LastModified
                End With
                With rstPreis       'Neue Preis-Positionen anfügen
                    .AddNew
                    !Position_F = rstNew!PositionID
                    !Einzelpreis = 0
                    ![MWST-Satz] = DLookup("[MWST]", "tblObjekt", "ObjektID = " & rstSource!Objekt_F)
                    .Update
                End With
                .MoveNext
            Loop
        End With
Das Problem: Nachdem ich eigentlich nur 2 Datensätze kopieren wollte hat sich das Programm nach 8000 kopierten Datensätzen aufgehängt. 

Bei näherer Betrachtung stellte ich fest, dass es sich bei der Do Until-Schlaufe um eine Endlosschlaufe handelt und EOF nie erreicht wird.

Meine Vermutung: Wenn im geklonten rstNew-Recordset ein neuer Datensatz hinzugefügt wird, verlängert sich auch rstSource, weshalb nie das Ende erreicht wird.

Wie kann ich das am besten lösen?

Vielen Dank für alle Hinweise.
Freundliche Grüsse

[TomKelly]

Hallo Minotaurus

Gehe ich richtig in der Annahme, dass die PositionID ein Autofeld ist? Wenn ja, und Acces noch nichts vermurkst hat (erkennbar durch grosse negative Werte im Autofeld, passiert leider ab und zu, und dann wird die einfache Lösung nicht funktionieren) kannst Du folgenden Ansatz wählen:
Lies zuerst die letzte PositionID aus und begrenze die Source auf diesen Wert:

lngLetzterWert = DMAX("PositionID", "tblPosition")
sqlSource = "Select ... ... Me.cboLieferscheine & " AND PositionID <= " & lngLetzterWert & ";"

Gruss
TomKelly