Mémoire insuffisante

'Permet de supprimer les doublons en fonction du telephone_standard 
Private Sub dbl_telephone_Click() 
Dim db As Database 
Set db = CurrentDb() 
Dim idPrec As String 'ID de la societe qu'on gardera 
Dim IdActu As String 'ID de la societe qu'on supprimera 
Dim sql As String 
Dim rs As Recordset 
Dim rsPrec As Recordset 
Dim rsActu As Recordset 
Dim rsPostal As Recordset 
Dim rsSaisiePrec As Recordset 
Dim rsSaisieActu As Recordset 
Dim compteur As Long 
Dim modif As Boolean 
Dim i As Integer 
Dim signaprec As Integer 
DoCmd.SetWarnings False 'Permet de supprimer les avertissements lors de la modification, l'ajout, la suppression.... 


DoCmd.RunSQL ("Delete * from doublonagarder;") 
DoCmd.RunSQL ("Delete * from societe_doublon;") 
'Insert dans societe_doublon les doublons en fonction du telephone_standard 
DoCmd.RunSQL ("Insert INTO societe_doublon select * FROM societe WHERE (((societe.telephone_standard) In (SELECT [telephone_standard] FROM [societe] As Tmp GROUP BY [telephone_standard] HAVING Count(*)>1 ))) order by telephone_standard, id_societe DESC;") 

'Initialisation 
compteur = 0 
modif = False 

Set rs = db.OpenRecordset("Select * FROM societe_doublon order by telephone_standard, id_societe DESC") 
If rs.EOF = True Then 
    MsgBox ("Il n'y a pas de doublons de sociétés ") 
Else 
    rs.MoveFirst 
    idPrec = rs!id_societe 'On donne à idprec l'id_societe du premier enregistrement 
    rs.MoveNext 
    'Boucle qui parcourt toute la Base de données 
    Do While rs.EOF = False 
        IdActu = rs!id_societe 
        sql = "Select * FROM societe_doublon WHERE id_societe=" & idPrec & ";" 
        Set rsPrec = db.OpenRecordset(sql) 'Ligne qu'on gardera (idprec) 
        sql = "Select * FROM societe_doublon WHERE id_societe=" & IdActu & ";" 
       Set rsActu = db.OpenRecordset(sql) 'Ligne qu'on supprimera (idactu) 
       signaprec = rsPrec!signaletique_ok 
        'Si le telephone_standard est identique alors 
        If rsPrec!telephone_standard = rsActu!telephone_standard Then 
            'ETAPE 1 : RsPrec est la ligne qu'on gardera, si un de ses champs est vide on le remplace par celui de RsActu 
            rsPrec.Edit 
                For i = 1 To rsPrec.Fields.Count - 3 
                    If IsNull(rsPrec.Fields(i).Value) = True Or rsPrec.Fields(i).Value = "" Or rsPrec.Fields(i).Value = 0 Then 
                        rsPrec.Fields(i).Value = rsActu.Fields(i).Value 
                    End If 
                Next i 
            rsPrec!signaletique_ok = signaprec 
            rsPrec.Update 
            'FIN DE L'ETAPE 1 
             
            'ETAPE 2 : On vérifie les signaletique_ok 
            'On vérifie que signaletique_ok de rsActu est égal à 1, si c'est le cas et que celui de rsPrec est 0 alors on remplace les champs de rsPrec par ceux de rsActu 
            If rsPrec!signaletique_ok = 0 And rsActu!signaletique_ok = 1 Then 
                modif = True 
            End If 
             
            'Si signaletique_ok de rsprec et de rsActu ont la même valeur 
            If (rsPrec!signaletique_ok = 1 And rsActu!signaletique_ok = 1) Or (rsPrec!signaletique_ok = 0 And rsActu!signaletique_ok = 0) Then 
            Set rsSaisieActu = db.OpenRecordset("Select date_saisie FROM actions WHERE id_societe=" & IdActu & " ORDER BY date_saisie DESC;") 'Date de saisie de rsActu 
            Set rsSaisiePrec = db.OpenRecordset("Select date_saisie FROM actions WHERE id_societe=" & idPrec & " ORDER BY Date_saisie DESC;") 'Date de saisie de rsPrec 
            'On vérifie que rsprec et rsActu ont une date de saisie 
                If rsSaisiePrec.EOF = False And rsSaisieActu.EOF = False Then 
                rsSaisiePrec.MoveFirst 
                rsSaisieActu.MoveFirst 
                    'Si la date de saisie de RsActu est plus récente que celle de rsPrec alors on remplace les champs de rsprec par ceux de rsactu 
                    If rsSaisiePrec!date_saisie < rsSaisieActu!date_saisie Then 
                        modif = True 
                    End If 
                End If 
            rsSaisieActu.Close 
            rsSaisiePrec.Close 
            End If 
            'FIN DE L'ETAPE 2 
            'ETAPE 3 : On modifie les champs de rsPrec par ceux de rsActu si il le faut 
            If modif = True Then 
                rsPrec.Edit 
                    For i = 1 To rsPrec.Fields.Count - 3 
                        If IsNull(rsActu.Fields(i).Value) = False And rsActu.Fields(i).Value <> "" And rsPrec.Fields(i).Value <> 1 Then 
                            rsPrec.Fields(i).Value = rsActu.Fields(i).Value 
                        End If 
                    Next i 
                rsPrec.Update 
            End If 
            'FIN DE L'ETAPE 3 
            'ETAPE 4 : On vérifie que si le pays est la France, alors le code postal concorde avec les deux premiers numéros du telephone_standard 
            If rsActu!pays = "France" Then 
                sql = "Select * FROM TablePostal WHERE code_Postal='" & Left(rsPrec!code_postal, 2) & "';" 
                Set rsPostal = db.OpenRecordset(sql) 'Ligne contenant l'indice téléphonique pour le code postal du rsPrec 
                If rsPostal.EOF = False Then 
                    'Si l'indice du téléphone et le code postal ne correspondent pas alors on remplace le code postal de rsPrec par celui de rsActu 
                    If Left(rsPrec!tel2, 2) <> rsPostal!indice_tel Then 
                        rsPrec.Edit 
                            rsPrec!code_postal = rsActu!code_postal 
                            rsPrec!ville = rsActu!ville 
                        rsPrec.Update 
                        rsPostal.Close 
                    End If 
                'Si le code postal de rsPrec ne correspond à aucun indice de téléphone alors on remplace le code postal de rsPrec par celui de rsActu 
                Else 
                    rsPrec.Edit 
                        rsPrec!code_postal = rsActu!code_postal 
                        rsPrec!ville = rsActu!ville 
                    rsPrec.Update 
                    rsPostal.Close 
                End If 
            End If 
            'FIN DE L'ETAPE 4 
             
            rsPrec.Close 
            rsActu.Close 
            DoCmd.RunSQL ("Update societe_doublon SET doublon=1 WHERE id_societe=" & IdActu & ";") 
            DoCmd.RunSQL ("Update societe_doublon SET doublon=2 WHERE id_societe=" & idPrec & ";") 
            compteur = compteur + 1 
            DoCmd.RunSQL ("Insert INTO TableCorrespondance (ID_ancienne,ID_nouvelle) values (" & IdActu & "," & idPrec & ");") 
        Else 
            'Si ce n'est pas un doublon alors on donne à idprec la valeur d'idactu 
            rsPrec.Close 
            rsActu.Close 
            idPrec = IdActu 
        End If 
    rs.MoveNext 
    Loop 
End If 
rs.Close 
DoCmd.RunSQL ("Insert INTO DoublonAjeter Select * FROM societe_doublon WHERE doublon=1 AND id_societe NOT IN (Select ID_societe FROM doublonajeter);") 
DoCmd.RunSQL ("Insert INTO DoublonAgarder Select *  FROM societe_Doublon WHERE doublon=2 AND id_societe NOT IN (select id_societe FROM doublonagarder);") 
DoCmd.RunSQL ("Delete * from societe WHERE id_societe IN (Select id_societe FROM societe_doublon);") 
DoCmd.RunSQL ("Insert INTO societe select * from doublonagarder;") 
MsgBox ("Il y a eu " & compteur & " doublons supprimés") 

End Sub