Gestion des tables liées via VB

Bonjour,
Il y a un certain temps, j'ai écrit ces fonctions permettant les attaches et dés-attaches de table.
Tu n'as qu'à insérer les 3 fonctions ci-dessous dans un module et le tour est joué.
Nota : Je n'ai pas eu le courage de vérifier si ce code est optimisé mais il fonctionne parfaitement (exemple : le cas error de la fonction table_existe n'est pas traité!). Toutes les applis que j'ai developpées les utilisent chaque jour, en environnement réseau.
Bonne continuation,
Eltino

Public Function attachT(ByVal strtable As String, strConnect As String, strSourceTable As String) as boolean
' Attache une table à la base de données courante, paramètres :
' strtable : nom local de la table à créer
' strconnect : localisation de la base où trouver la table à attacher
' strsourcetable : nom de la table dans la base source

On Error GoTo Err_attachT

Dim dbsTemp As Database
Dim tdfLinked As TableDef
Dim rstLinked As Recordset
Dim intTemp As Integer
Dim endroit As String
endroit = ";DATABASE=" & strConnect
   
Set dbsTemp = CurrentDb

' Crée un objet TableDef, définit ses propriétés
' Connect et SourceTableName en fonction des
' arguments passés et ajoute l'objet à la collection TableDefs.
Set tdfLinked = dbsTemp.CreateTableDef(strtable)

tdfLinked.Connect = endroit
tdfLinked.SourceTableName = strSourceTable
dbsTemp.TableDefs.Append tdfLinked

' table attachée ?
If table_existe(strtable) <> "no found" Then
    attachT = True
Else
    attachT = False
End If
Exit Function

Err_attachT:
    attachT = False
    Exit Function
End Function

Public Function detachT(ByVal strtable As String) as boolean
' Supprime l'attache d'une table dont le nom est passé en paramètre

' si la table n'existe pas, inutile d'aller plus loin
If table_existe(strtable) = "no found" Then
    detachT = True
    Exit Function
End If

On Error GoTo Err_detachT

Dim dbsTemp As Database
Set dbsTemp = CurrentDb
dbsTemp.TableDefs.Delete strtable
Set dbsTemp = Nothing

' table détachée ?
If table_existe(strtable) = "no found" Then
    detachT = True
Else
    detachT = False
End If
Exit Function

Err_detachT:
    Set dbsTemp = Nothing
    detachT = False
    Exit Function
End Function

Public Function table_existe(ByVal strtable As String)
' Est-ce que la table donnée existe dans la base courante ?
On Error GoTo err_table_existe
Dim dbs As Database, tdfLoop As TableDef, strrep As String
Set dbs = CurrentDb
strrep = "no found"
For Each tdfLoop In dbs.TableDefs
    If UCase(tdfLoop.Name) = UCase(strtable) Then
        strrep = strtable
        Exit For
    End If
Next tdfLoop
Set tdfLoop = Nothing
Set dbs = Nothing
table_existe = strrep
Exit Function

err_table_existe:
Set tdfLoop = Nothing
Set dbs = Nothing
table_existe = "error"
End Function

Salut,

Pour la fonction table_existe, tu oublies de declarer son type
Public Function table_existe(ByVal strtable As String) As String

Ensuite , moi je fais comme ceci:

Public Function table_existe(ByVal strtable As String) As Boolean
' Est-ce que la table donnée existe dans la base courante ?

Dim dbs As Database
Set dbs = CurrentDb

Dim i As integer, xCount As Integer
xCount =dbs.TableDefs.Count
For =i=1 To xCount
   If UCase(strtable)=UCase(dbs.TableDefs(i).Name) Then
        table_existe=True
        Exit For
    End If
Next
End Function

I LIKE TO BE HERE WHEN I CAN