Liaisons tables en VBA

Version imprimable

Bonjour,

Je voudrais utiliser le code de la discussion de oleff
http://www.developpez.net/forums/d91...bles-base-vba/

J’ai créé la Table tblTablesAttachees avec un seul champ TablesAttachees, et j’ai inscrit les noms des tables attachées.

Lorsque je lance le code j’ai une erreur « incompatibilite de type » après exit Function de la Function Table_Existe.

Et je ne comprends pas pour quelles raisons j’ai cette erreur.

Set tdfLoop = Nothing
Set dbs = Nothing
table_existe = strrep
Exit Function

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Private Sub Commande0_Click()
Dim rst As Recordset
Dim strCheminBd As String
strCheminBd = CurrentProject.Path
strCheminBd = strCheminBd & "\" & "Comptoir_princip.mdb"
'Ouverture du recordset rst des tables à éxaminer...
Set rst = CurrentDb.OpenRecordset("tblTablesAttachees")
If table_existe(rst!TablesAttachees) Then
   detachT rst!NomTablesAttachees
   CurrentDb.TableDefs.Refresh
   attachT rst!NomTablesAttachees, rst!strCheminBd, rst!NomTablesAttachees
End If
rst.MoveNext
End Sub

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
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

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
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

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
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

Merci pour votre aide.

Salutations

Bonjour,

Cette ligne

Code:

If table_existe(rst!TablesAttachees) Then

n'est pas conforme à l'utilisation de If .. Then .

Code:

If (expression booléenne) Then

La fonction table_existe renvoie une valeur chaîne de caractère qui ne peut pas être convertie en type booléen.

Je pense que le code de ton bouton peut se réduire à
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 Private Sub Commande0_Click() Dim db As DAO.Database, rst As DAO.Recordset Dim strCheminBd As String strCheminBd = CurrentProject.Path strCheminBd = strCheminBd & "\" & "Comptoir_princip.mdb" 'Ouverture du recordset rst des tables à éxaminer... Set db = CurrentDb Set rst = db.OpenRecordset("tblTablesAttachees") Do While Not rst.EOF detachT rst!TablesAttachees attachT rst!TablesAttachees, strCheminBd, rst!TablesAttachees rst.MoveNext Loop Application.RefreshDatabaseWindow End Sub
Tu n'as pas besoin de tester l'existence de la table liée.
detachT la supprime si elle existe et ne fait rien si elle n'existe pas.
Ensuite attachT lie la table à attacher.

A+

13/03/2011, 21h02
jmde

Bonsoir LedZeppII,

Merci pour ta réponse la modification fonctionne correctement.

Mais je aperçois que si pour une raison quelconque la table tblTablesAttachees n’est pas liée une erreur se produit.

Pour éviter cela peut-on lire la table à partir de la Dorsale et
faire la liaison des tables ?

Salutations

Bonjour LedZeppII ,

Pour mon problème j’ai rajouté sur le code du bouton le test de la table tblTablesAttachées et ça fonctionne, mais est-ce la bonne solution ?

Code:

1
2
3
4
5
6
7
'--- Teste l'éxistence de la table
     If TesteExistenceTable("tblTablesAttachees") Then
 
'--- Crée table liée dans base en cours
     DoCmd.TransferDatabase acLink, "Microsoft Access", strCheminBd, acTable, _
                                   "tblTablesAttachees", "tblTablesAttachees"
     End If

Salutations

14/03/2011, 19h13
LedZeppII

Bonsoir,

Citation:

Envoyé par jmde

... je aperçois que si pour une raison quelconque la table tblTablesAttachees n’est pas liée une erreur se produit.

Pour éviter cela peut-on lire la table à partir de la Dorsale et
faire la liaison des tables ?

En général on met cette table dans la frontale.
Comme ça elle est toujours présente.

A+
15/03/2011, 00h32
jmde

Bonsoir,

Citation:

En général on met cette table dans la frontale.
Comme ça elle est toujours présente.

Merci c'est noté.

Salutations