Insufficient memory

 'Allows to remove duplicates based on telephone_standard
Private Sub dbl_telephone_Click()
    Dim db As Database
    Set db = CurrentDb()
    Dim idPrec As String 'ID of the company to keep
    Dim IdActu As String 'ID of the company to remove
    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 'Allows to suppress warnings during modification, addition, deletion...
    DoCmd.RunSQL ("Delete * from doublonagarder;")
    DoCmd.RunSQL ("Delete * from societe_doublon;")

    'Insert into societe_doublon the duplicates based on 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;")

    'Initialization
    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 ("There are no duplicate companies ")
    Else
        rs.MoveFirst
        idPrec = rs!id_societe 'Assigning the ID of the first record to idPrec
        rs.MoveNext

        'Looping through the entire database
        Do While rs.EOF = False
            IdActu = rs!id_societe
            sql = "Select * FROM societe_doublon WHERE id_societe=" & idPrec & ";"
            Set rsPrec = db.OpenRecordset(sql) 'Row that we will keep (idPrec)

            sql = "Select * FROM societe_doublon WHERE id_societe=" & IdActu & ";"
            Set rsActu = db.OpenRecordset(sql) 'Row that we will remove (idActu)

            signaprec = rsPrec!signaletique_ok 'If the telephone_standard is identical then
            If rsPrec!telephone_standard = rsActu!telephone_standard Then
                'STEP 1: RsPrec is the row we will keep, if any of its fields are empty, we replace them with those from 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 'END OF STEP 1

                'STEP 2: Checking the signaletique_ok
                'We check if signaletique_ok of rsActu equals 1, if yes and that of rsPrec is 0 then we replace the fields of rsPrec with those of rsActu
                If rsPrec!signaletique_ok = 0 And rsActu!signaletique_ok = 1 Then
                    modif = True
                End If

                'If signaletique_ok of rsPrec and rsActu have the same value
                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 of entry of rsActu
                    Set rsSaisiePrec = db.OpenRecordset("Select date_saisie FROM actions WHERE id_societe=" & idPrec & " ORDER BY Date_saisie DESC;") 'Date of entry of rsPrec

                    'Check that rsPrec and rsActu have an entry date
                    If rsSaisiePrec.EOF = False And rsSaisieActu.EOF = False Then
                        rsSaisiePrec.MoveFirst
                        rsSaisieActu.MoveFirst
                        'If the entry date of RsActu is more recent than that of rsPrec then we replace the fields of rsPrec with those of rsActu
                        If rsSaisiePrec!date_saisie < rsSaisieActu!date_saisie Then
                            modif = True
                        End If
                    End If
                    rsSaisieActu.Close
                    rsSaisiePrec.Close
                End If 'END OF STEP 2

                'STEP 3: We modify the fields of rsPrec with those of rsActu if necessary
                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 'END OF STEP 3

                'STEP 4: We check that if the country is France, the postal code matches the first two digits of the telephone_standard
                If rsActu!pays = "France" Then
                    sql = "Select * FROM TablePostal WHERE code_Postal='" & Left(rsPrec!code_postal, 2) & "';"
                    Set rsPostal = db.OpenRecordset(sql) 'Row containing the telephone index for the postal code of rsPrec
                    If rsPostal.EOF = False Then
                        'If the telephone index and the postal code do not match then we replace the postal code of rsPrec with that of 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
                    Else
                        'If the postal code of rsPrec does not match any telephone index then we replace the postal code of rsPrec with that of rsActu
                        rsPrec.Edit
                        rsPrec!code_postal = rsActu!code_postal
                        rsPrec!ville = rsActu!ville
                        rsPrec.Update
                        rsPostal.Close
                    End If
                End If 'END OF STEP 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 'If it is not a duplicate then we assign idprec the value of 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 ("There were " & compteur & " duplicates removed")
End Sub