Gestion des tables liées via VB
Résolu
Tuxyl
Messages postés
4
Date d'inscription
samedi 24 juillet 2004
Statut
Membre
Dernière intervention
2 septembre 2007
-
24 août 2007 à 12:21
cs_Ouneufe Messages postés 60 Date d'inscription mardi 4 septembre 2001 Statut Membre Dernière intervention 19 janvier 2009 - 30 avril 2008 à 10:48
cs_Ouneufe Messages postés 60 Date d'inscription mardi 4 septembre 2001 Statut Membre Dernière intervention 19 janvier 2009 - 30 avril 2008 à 10:48
4 réponses
eltino
Messages postés
8
Date d'inscription
mardi 16 septembre 2003
Statut
Membre
Dernière intervention
16 décembre 2008
28 août 2007 à 16:47
28 août 2007 à 16:47
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
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
chaibat05
Messages postés
1883
Date d'inscription
samedi 1 avril 2006
Statut
Membre
Dernière intervention
20 novembre 2007
2
28 août 2007 à 17:06
28 août 2007 à 17:06
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
<hr />
I LIKE TO BE HERE WHEN I CAN
<hr />
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
<hr />
I LIKE TO BE HERE WHEN I CAN
<hr />
Tuxyl
Messages postés
4
Date d'inscription
samedi 24 juillet 2004
Statut
Membre
Dernière intervention
2 septembre 2007
2 sept. 2007 à 19:58
2 sept. 2007 à 19:58
Merci infiniment !! C'est exactement ce que mon programme a besoin.
Encore merci à vous deux
Encore merci à vous deux
cs_Ouneufe
Messages postés
60
Date d'inscription
mardi 4 septembre 2001
Statut
Membre
Dernière intervention
19 janvier 2009
30 avril 2008 à 10:48
30 avril 2008 à 10:48
Très cool, c'est strictement ce dont j'avais besoin.
le feu ça fait peur mais avec l'eau tu l'arrêtes, le feu.
L'eau, tu l'arrêtes pas.
le feu ça fait peur mais avec l'eau tu l'arrêtes, le feu.
L'eau, tu l'arrêtes pas.
