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ée
                 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ée
End Function