Dubbele records uit tabel verwijderen (2)

Status
Niet open voor verdere reacties.
F

fmeca

Gebruiker
Lid geworden
7 sep 2009
Berichten
95
Hoi Wizzkids

In navolging van de tread op het verwijderen van dubbele rijen zit ik met hetzelfde probleem.
Ik heb onderstaande code bedacht voor het echt verwijderen, i.p.v. filteren, van dubbele records.

M.b.v. een knop op een formulier wil ik de dubbele records verwijderen.
Ik vergelijk de record op [PrüflingID] en [PrüfDatum]. Indien deze gelijk zijn mag de record verwijderd worden.

De code werkt slecht gedeeltelijk. Verschillende dubbele records blijven staan.
Waarschijnlijk zit de fout ergens in de selectie, definitie of controle van de datumcriteria.
Waar ga ik de fout in????

De gedachtegang:
- LOOP door de tabel Prüfung record voor record;
- Controleer of van de gekozen record het PrüflingID in combinatie met de datum, meerdere keren voorkomt (DCOUNT);
- Indien JA, verwijder de record (DoCmd.RunSQL "DELETE ......);
- Tel het aantal verwijderde records (MsgBox iCountDelRec).

In de zip een test programma

Ik kopieer de tabel van te voren voor test doeleinden (hergebruik, DoCmd.CopyObject.... ).

Code: 
Private Sub Knop_DubRecVerw_DblClick(Cancel As Integer)

On Error GoTo Err_Knop_DubRecVerw_DblClick
'Verwijderen van dubbele keuringen van hetzelfde apparaat (Prüfling) op dezelfde datum
    Dim rs As DAO.Recordset
    Dim db As DAO.Database
    Dim iCountDelRec As Integer

    If MsgBox("Dubbele keuringen, met gelijk ID, nummer en testdatum, verwijderen?", vbYesNo, "D U B B E L E   K E U R I N G E N") = vbYes Then
        Set db = CurrentDb
        Set rs = db.OpenRecordset("Prüfung")
        iCountDelRec = 0
        'TIJDELIJK: Kopieer de huidige tabel
        DoCmd.CopyObject , "PrüfungCopy" & Date, acTable, "Prüfung"
        Do Until rs.EOF
            'MsgBox rs!PrüfungID & "  " & rs!Prüfdatum & "   " & DCount("PrüflingID", "Prüfung", "Prüfdatum = # " & rs!Prüfdatum & "# and PrüflingID = " & rs!PrüflingID)
            If DCount("PrüflingID", "Prüfung", "Prüfdatum = # " & rs!Prüfdatum & "# and PrüflingID = " & rs!PrüflingID) > 1 Then
                'Delete Record
                DoCmd.SetWarnings False
                DoCmd.RunSQL "DELETE * FROM Prüfung" _
                    & " WHERE Prüfdatum = # " & rs!Prüfdatum & " # AND PrüfungID = " & rs!PrüfungID & ";"
                DoCmd.SetWarnings True
                iCountDelRec = iCountDelRec + 1
            End If
            rs.MoveNext
        Loop
        MsgBox iCountDelRec & " Gedubbelde keuring(en) verwijderd"
    End If

Exit_Knop_DubRecVerw_DblClick:
    Exit Sub

Err_Knop_DubRecVerw_DblClick:
    MsgBox Err.Description
    Resume Exit_Knop_DubRecVerw_DblClick
    
End Sub

Bekijk bijlage DelDubRecords.zip

Excuus voor de termelogie. De tabel komt uit een software pakket van duitse makelij.

THX voor meedenken.
Eric
 
Ik vind het een rare constructie; eerst een Recordset openen en vervolgens een aparte query op dezelfde tabel loslaten. Waarom niet alles in de Recordset uitgevoerd?
 
Allereerst dank je voor de opmerking Octafish.

In eerste instantie wist ik niet wat ik hiermee aanmoest. :confused:
Een kleine studie hierover deed mij het licht zien.:thumb:

Aldus opgelost.:thumb:

Code: 
On Error GoTo Err_Knop_DubRecVerw_DblClick
'Verwijderen van dubbele keuringen van hetzelfde apparaat (Prüfling) op dezelfde datum
    Dim rs As DAO.Recordset
    Dim db As DAO.Database
    Dim iCountDelRec As Integer
    Dim strSQL, strName, strDate As String

    If MsgBox("Dubbele keuringen, met gelijk ID, nummer en testdatum, verwijderen?", vbYesNo, "D U B B E L E   K E U R I N G E N") = vbYes Then
        Set db = CurrentDb
        strSQL = "SELECT  * FROM Prüfung ORDER BY PrüflingID, Prüfdatum, PrüfungID"
        Set rs = db.OpenRecordset(strSQL, dbOpenDynaset)
        iCountDelRec = 0
     'TIJDELIJK: Kopieer de huidige tabel
        DoCmd.CopyObject , "PrüfungDelDubPrevCopy", acTable, "Prüfung"
        DoCmd.SetWarnings False
    
     'If no records in rs table, exit.
        If rs.EOF Then Exit Sub
    
        strName = rs![PrüflingID]
        strDate = rs![Prüfdatum]
        rs.MoveNext
    
        Do Until rs.EOF
            If rs![PrüflingID] = strName And rs![Prüfdatum] = strDate Then
                rs.Delete
                iCountDelRec = iCountDelRec + 1
           Else
                strName = rs![PrüflingID]
                strDate = rs![Prüfdatum]
           End If
           rs.MoveNext
        Loop
        MsgBox iCountDelRec & " Gedubbelde keuring(en) verwijderd"
    End If
    DoCmd.SetWarnings True
 
Ziet er al een stuk beter uit :). Volgens mij kunnen de Setwarnings regels er nu ook uit, want die hebben geen invloed op de recordset.
 
THX. Ik ben nog niet zo goed thuis in het werken met record sets.

Loop toch tegen een probleempje aan.
Hoe bepaal je dat hij de records met de hoogste recordID verwijderd en de oudste handhaaft?

Nu is de selectie random.

Als ik de reord ID in de "SELECT ...." opneem verwijdert hij niks. (omdat deze uniek is? en niet dubbel voorkomt?)
 
Maak een query die alleen de te verwijderen records selecteert. Dus een query dubbele records maken die ze eerst filtert, en die zo aanpassen dat de records met de hogere id's overblijven. Al die records kunnen dan weg. Ik heb onlangs daar een voorbeeldje van gemaakt in het forum. Zoek die maar eens op.
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan