Discussion :

[Manue_Y]

Bonjour à tous.

Je suis développeur Access, j'utilise actuellement Access 2003.

J'ai besoin de convertir toutes mes tables attachées en tables locales automatiquement, c'est à dire que lorsque l'utilisateur cliquera sur le bouton de conversion, il faudrait que toutes les tables attachées soient mises en local dans une nouvelle base de données.

J'ai déjà essayer plusieurs options telles que
-docmd.transfertdatabase
-docmd.copyobject

Mais les tables restent liées.

Je vous remercie déjà de l'attention porté sur ce message

[Tofalu]

Le principe est simple :

1. Creer la nouvelle base de données
2. Exporter chaque table.

Ce qui donnerait dans un module (aprés avoir ajouter une réference Microsoft DAO à ton projet (outils/references)) :

Option Compare Database
Option Explicit

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
39
40
Sub Exporter()
On Error GoTo err
Dim Db As DAO.Database
Dim DBDest As DAO.Database
Dim NomFichier As String
Dim TblDef As DAO.TableDef
Dim Erreur As String
NomFichier = "D:\testing.mdb"
'Cree la nouvel BD
Set DBDest = DBEngine.CreateDatabase(NomFichier, dbLangGeneral)
DoEvents
'Instancie l'objet DB courant
Set Db = CurrentDb
'Parcours les tables
For Each TblDef In Db.TableDefs
  'si la table est attachée
  If TblDef.Attributes And dbAttachedTable Then
  export TblDef.Name, NomFichier, Erreur
  End If
Next TblDef
If Erreur = "" Then
MsgBox "fini"
Else
MsgBox "Les tables suivantes n'ont pas été exportées" & vbCrLf & vbCrLf & Erreur
End If
Exit Sub
err:
Select Case err.Number
  Case 3204: MsgBox "Le fichier existe déjà", vbCritical, "Erreur"
  Case Else: MsgBox "Une erreur inconue est survenue", vbCritical, "Erreur"
End Select
End Sub
 
Sub export(ByVal NomTable As String, ByVal fichier As String, messageerreur As String)
On Error GoTo err
DoCmd.TransferDatabase acExport, "Microsoft ACCESS", fichier, acTable, NomTable, NomTable
Exit Sub
err:
messageerreur = messageerreur & NomTable & vbCrLf
End Sub

Aprés y a plus qu'à lancer la première sub depuis un bouton. Pour choisir le chemin du fichier, y a de quoi faire dans la FAQ (getopenfilename)

[Manue_Y]

Je te remercie Tofalu pour ta réponse qui fut rapide!

Mais vois-tu, dans ton exemple de code, les tables exportées sont toujours attachées à d'autres données, d'ailleurs, seules les tables attachées sont exportées.

Alors que j'ai besoin que ces tables attachées soient, lors de l'exportation mises en locale dans une nouvelle base afin que l'utilisateur n'ait pas besoin de prendre toutes les tables des différentes bases auxquelles sont liées les tables.

Malgré tout, tu m'as appris quelque chose. Je sais désormais exporter des tables tout en gardant leur chemin d'accès dans une nouvelles base.

Merci encore

[Tofalu]

Alors :

d'ailleurs, seules les tables attachées sont exportées.

C'est ce que tu souhaitais

J'ai besoin de convertir toutes mes tables attachées en tables locales automatiquement, c'est à dire que lorsque l'utilisateur cliquera sur le bouton de conversion, il faudrait que toutes les tables attachées soient mises en local dans une nouvelle base de données.

Mais vois-tu, dans ton exemple de code, les tables exportées sont toujours attachées à d'autres données,

En effet je n'avais pas vu. Bon alors, je recherche un vieux code et j'adate

[Tofalu]

Evidemment c'est beaucoup plus long

La procédure à lancée reste la même :

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
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
Option Compare Database
Option Explicit
 
Sub Exporter()
On Error GoTo err
Dim Db As DAO.Database
Dim DbDest As DAO.Database
Dim NomFichier As String
Dim Erreur As String
Dim TblSource As DAO.TableDef
NomFichier = "D:\testing.mdb"
'Cree la nouvel BD
Set DbDest = DBEngine.CreateDatabase(NomFichier, dbLangGeneral)
DoEvents
'Instancie l'objet DB courant
Set Db = CurrentDb
'Parcours les tables
For Each TblSource In Db.TableDefs
  'si la table est attachée
  If TblSource.Attributes And dbAttachedTable Then
  export TblSource, Erreur, Db, DbDest
  End If
Next TblSource
If Erreur = "" Then
MsgBox "fini"
Else
MsgBox "Les tables suivantes n'ont pas été exportées" & vbCrLf & vbCrLf & Erreur
End If
Exit Sub
err:
Select Case err.Number
  Case 3204: MsgBox "Le fichier existe déjà", vbCritical, "Erreur"
  Case Else: MsgBox "Une erreur inconue est survenue", vbCritical, "Erreur"
End Select
End Sub
 
Sub export(TblSource As DAO.TableDef, messageerreur As String, Db As DAO.Database, DbDest As DAO.Database)
On Error GoTo err
Dim Fld As DAO.Field
Dim Ind As DAO.Index
Dim Tbldest As DAO.TableDef
Set Tbldest = DbDest.CreateTableDef(TblSource.Name)
  'clone les champs
  For Each Fld In TblSource.Fields
  CloneChamp Fld, Tbldest, Fld.Name
  Next Fld
  'Clone les index
  For Each Ind In TblSource.Indexes
    CloneIndex Ind, Tbldest, Ind.Name
  Next Ind
  'Ajoute la table à la collection
  DbDest.TableDefs.Append Tbldest
  'Importe les données
  Db.Execute ("INSERT INTO " & TblSource.Name & " IN " & Chr(34) & DbDest.Name & Chr(34) & " SELECT * FROM " & TblSource.Name)
Exit Sub
err:
messageerreur = messageerreur & TblSource.Name & vbCrLf
End Sub
 
Private Sub EcrirePropriete(Propriete As DAO.Property, ObjetDestination As Object)
On Error GoTo err
'Copie la propriété
With ObjetDestination.Properties
 .Item(Propriete.Name) = Propriete.Value
 .Refresh
End With
'On ne traite pas les erreurs
err:
End Sub
 
Public Sub CloneChamp(FldSource As DAO.Field, TableDestination As DAO.TableDef, _
  NouveauNom As String)
On Error GoTo err
Dim Fld As DAO.Field
Dim Prp As DAO.Property
'Cree le champ
Set Fld = TableDestination.CreateField(NouveauNom)
'Pour chaque propriete
For Each Prp In FldSource.Properties
 'copier la propriété s'il ne s'agit pas du nom
 If Prp.Name <> "Name" And Prp.Name <> "Value" Then _
        EcrirePropriete Prp, Fld
Next Prp
'Ajoute le champ
TableDestination.Fields.Append Fld
Exit Sub
err:
Select Case err.Number
   Case 3010, 3191: MsgBox "Le champ " & NouveauNom & " existe déjà"
   Case Else: MsgBox "Une erreur inattendue est survenue"
End Select
End Sub
Public Sub CloneIndex(IndSource As DAO.Index, TableDestination As DAO.TableDef, _
  NouveauNom As String)
On Error GoTo err
Dim Ind As DAO.Index
Dim Fld As DAO.Field, FldDest As DAO.Field
Dim Prp As DAO.Property
'Cree le champ
Set Ind = TableDestination.CreateIndex(NouveauNom)
'Copie les champs de l'index
For Each Fld In IndSource.Fields
 'Duplique le champ
 Set FldDest = Ind.CreateField(Fld.Name)
 'applique les mêmes propriétés
 For Each Prp In Fld.Properties
    EcrirePropriete Prp, FldDest
 Next Prp
'Ajoute le champ
Ind.Fields.Append FldDest
Next Fld
'Pour chaque propriete
For Each Prp In IndSource.Properties
 'copier la propriété s'il ne s'agit pas du nom
 If Prp.Name <> "Name" Then _
        EcrirePropriete Prp, Ind
Next Prp
'Ajoute l'index
TableDestination.Indexes.Append Ind
Exit Sub
err:
End Sub

[Manue_Y]

Ca y est, ça marche! Je te remercie beaucoup, j'ai encore appris quelque chose, me voilà moins bête qu'hier dis donc!

[Manue_Y]

J'ai parlé un peu trop vite car il me reste un petit problème à régler

Si les tables attachées exportées ont un nom en un seul mot, du type "CATEGORIE", tout va bien.

Tandis que lorsque qu'une table a un nom composé du type : "FEUILLE DE POINTAGE", la création de la table dans la nouvelle base s'effectue correctement mais l'ajout des lignes ne se fait pas.

En effet, il y a une erreur qui se déclenche dans l'instruction INSERT INTO.

Je n'ai toujours pas trouvé la solution.

[Tofalu]

Ben oui parce que normalement on évite les espaces. Mais bon, cela donne :

Code :

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

Db.Execute ("INSERT INTO [" & TblSource.Name & "] IN " & Chr(34) & DbDest.Name & Chr(34) & " SELECT * FROM [" & TblSource.Name & "]")

Voilà, c'était un oubli de ma part

[Manue_Y]

Non, c'est moi qui devrait rougir !

C'était une première expérience pour ce type d'exportation et je peux dire que grâce à ton aide, elle a été réalisée avec succès!

J'ai une excuse pour le nom composé des certaines tables! (je sais qu'une excuse est faite pour être bidon!) mais c'est la réalité!

C'est une base que j'ai repris après le départ de l'informaticien qui me précédait!

Ce projet me tient beaucoup à coeur alors merci encore.