Liaisons tables en VBA

**jmde** · 13/03/2011, 13h33

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

**LedZeppII** · 13/03/2011, 14h24

Bonjour,

Cette ligne

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

If table_existe(rst!TablesAttachees) Then

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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+

**jmde** · 13/03/2011, 21h02

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

**jmde** · 14/03/2011, 10h44

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

**LedZeppII** · 14/03/2011, 19h13

Bonsoir,

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+