Function xDropRelations()
Dim Rel As Relation
    For Each Rel In CurrentDb.Relations
        Debug.Print "effacement de la relation [" & Rel.Table & "]![" & Rel.Fields(0).name & "] -=-> _
                         & "[" & Rel.ForeignTable & "]![" & Rel.Fields(0).ForeignName & "]"
        CurrentDb.Relations.Delete Rel.name
    Next Rel
End Function

CurrentDb.Relations.Delete "NomTableUnNomTableDeux" 

   'On crée une relation et définit ses propriétés. 
Dim rel as DAO.Relation 
 'Définit les attributs de l'objet Relation pour appliquer l'intégrité référentielle. 
Set rel = Currentdb.CreateRelation("CommandesEmployés", "Employés", "Commandes") 
 ' On crée un champ dans la collection Fields de l'objet Relation 
rel.Attributes = dbRelationDeleteCascade + dbRelationUpdateCascade 
 ' On ajoute le champ à l'objet Relation et l'objet
Set chp = rel.CreateField("N° employé") ' Fournit le nom du champ clé externe. 
chp.ForeignName = "N° employé"  
rel.Fields.Append chp 
Currentdb.Relations.Append rel

DoCmd.DeleteObject acTable, fichier & "_ImportErrors"

CurrentDB.TableDefs.Delete fichier & "_ImportErrors"

Function PurgeErreurs()

Dim tbl As TableDef
For Each tbl In CurrentDb.TableDefs
 If InStr(tbl.Name, "importerrors") Then
    Debug.Print "Effacement de " & tbl.Name
    CurrentDb.TableDefs.Delete tbl.Name
 End If
Next tbl

Set tbl = Nothing

End Function

Function TrouverCP(nom_table As String) As String

    Dim bds As Database, dft As TableDef, chp As Field
    Dim idx As Index

    ' base de données en cours.
    Set bds = CurrentDb
   
    ' Retourne un objet Tabledef pointant sur une table.
    Set dft = bds.TableDefs(nom_table)

    ' Parcourt la collection Indexes de l'objet TableDef.
    For Each idx In dft.Indexes

        ' Vérifie la propriété Primary de l'index de
        ' l'objet Recordset.     
        If idx.Primary Then
             For Each chp In idx.Fields
                 TrouverCP = chp.Name   'clef primaire trouvé
                 Set bds = Nothing
               Exit Function ' on quitte la fonction
            Next chp
        End If
    Next idx

    Set bds = Nothing
TrouverCP = "null"  ' pas de clef primaire trouvé
End Function