Discussion :

[NazOok]

Bonjour à tous,

J'ai pas mal fouillé sur le net (ça fait 2/3 jours à vrai dire) et je n'ai pas trouvé complétement la réponse à mon problème même si j'ai déjà bien avancé, je me permet donc de créer ce sujet.

Je vous explique un peu mon cas :
J'ai donc une base Access fractionnée, une frontale sur chaque poste utilisateur et une dorsale située sur un SharePoint. A partir de la frontale, j'ai une fonction qui permet de récupérer des données à partir de fichier Excel et d'alimenter/modifier ma base dorsale en données. Je souhaite donc avant chaque lancement de ma fonction, faire une sauvegarde de ma base dorsale en local pour le moment (sur un serveur distant par la suite).

J'ai bien vu qu'il n'était pas difficile de faire une sauvegarde d'une base en local ou simplement sur un serveur en faisant une copie du fichier ".accdb" mais pour la sauvegarde d'une base sur SharePoint c'est autre chose...
Puisque je ne souhaite pas sauvegarder une base avec simplement mes liens vers le SharePoint mais bel et bien les données de ma base à un instant T !

Donc mon but est de faire une sauvegarde de ma base en locale et compatible WEB afin de pouvoir la publier sur mon SharePoint a tout moment si nécessaire.

Donc à présent, j'ai réussi à partir de ma base frontale, à créer une nouvelle base en locale, créer mes tables identiques à mes tables liées au SharePoint et recopier mes données dans celle-ci tout en gardant mes index et mes relations entre tables (c'est déjà un bon point).

Sauf que pour publier ma nouvelle base sur le SharePoint, celle-ci doit être compatible WEB, hélas il me reste les points bloquants suivant :

1. Mes clés primaires n'ont pas étaient copiées correctement
2. Mes relations n'ont pas étaient copiées correctement

Pour mes clés primaires :
Le champ est bel et bien copié mais la propriété "clé primaire" soit "primary" n'a pas fonctionnée... Pourtant, en débug, sur la recopie de la propriété "primary" du champ, elle est bien copiée avec un était à VRAIE alors qu'en ouvrant ma nouvelle base, je n'ai aucune clé primaire dans mes tables...
La question est : comment faiiiiiiiiiire ??

Pour mes relations :
Comme vous le savez peut être, la définition des relations pour une base Access compatible WEB ne se fait pas de la même manière. Le fait de créer une relation avec l'assistant à partir du schéma de relation n'est pas compatible WEB, avant de publier ma base sur la SharePoint j'ai été contraint à supprimer toutes ces relations et les créer sur chaque table en ajoutant des champs "Liste de choix et relations" pointant vers le champ voulu de la table reliée. Donc a présent, avec mon code ci-dessous j'arrive a copier mes relations mais elles ne sont pas compatible WEB !!
La question est : Comment récupérer les propriétés d'un champ se trouvant dans l'onglet "Propriétés\Liste de Choix" ????? Je n'ai pas trouvééééé ....

J'ai aussi un problème pour un champ d'une table qui est de type "Texte" mais au final une "Liste de valeurs" avec 3 valeurs possibles... Cette définition se trouve également dans l'onglet "Propriétés\Liste de Choix" => C'est donc liéé avec mon problème de relations !

Voici le code de mon module nommé "SauvegardeBDD" :
(PS : un grand merci à Tofalu pour sa réponse qui m'a été précieuse sur ce topic ! Il s'agit ci-dessous d'une copie avec adaptation et rajout de la recopie des relations)

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
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
 
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
    Dim Rlt As DAO.Relation
 
    'Nom de mon fichier : 'Chemin\Temp - date - heure.accd'
    Dim nomBaseSauvegarde As String
    Dim dateHeureActuelleFormat As String
    dateHeureActuelleFormat = Format(Now, "dd-mm-yyyy - hh-mm-ss")
    nomBaseSauvegarde = StringFormat("Temp - {0}.accdb", dateHeureActuelleFormat)
    NomFichier = StringFormat("C:\Users\cyomont\Documents\#AFFAIRES\#Outil PDC\V8.0.0\{0}", nomBaseSauvegarde)
 
    '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 & commence par "T_"
      If TblSource.Attributes And dbAttachedTable _
            And Left(TblSource.Name, 2) = "T_" Then
        export TblSource, Erreur, Db, DbDest
      End If
    Next TblSource
 
    'On parcours les relations
    For Each Rlt In Db.Relations
        'si le nom de la table reliée commence par "T_"
        If Left(Rlt.Table, 2) = "T_" Then
            CloneRelation Rlt, Db, DbDest, Rlt.Name
        End If
    Next Rlt
 
    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 StringFormat("INSERT INTO [{0}] IN ""{1}"" SELECT * FROM [{0}]", TblSource.Name, DbDest.Name)
 
    'On supprime les propriétées liées au SharePoint
    DbDest.Execute StringFormat("ALTER TABLE {0} DROP COLUMN SharePointTitle, _OldID, [ID de l'instance du flux de travail], [Type de fichier], SharePointEditor, SharePointAuthor, SharePointModifiedDate, SharePointCreatedDate, [Chemin d'URL], [Chemin d'accès], [Type d'élément], [URL absolue codée]", 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
        End If
    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
        End If
    Next Prp
 
    'Ajoute l'index
    TableDestination.Indexes.Append Ind
 
    Exit Sub
err:
End Sub
 
 
Public Sub CloneRelation(RltSource As DAO.Relation, Db As DAO.Database, DbDest As DAO.Database, NouveauNom As String)
    On Error GoTo err
    Dim Rlt As DAO.Relation
    Dim Fld As DAO.Field, FldDest As DAO.Field
    Dim Prp As DAO.Property
 
    'Créé la relation
    Set Rlt = DbDest.CreateRelation(NouveauNom)
 
    'Copie les champs de l'index
    For Each Fld In RltSource.Fields
        'Duplique le champ
        Set FldDest = Rlt.CreateField(Fld.Name)
        'applique les mêmes propriétés
        For Each Prp In Fld.Properties
            EcrirePropriete Prp, FldDest
        Next Prp
 
        'Ajoute le champ
        Rlt.Fields.Append FldDest
    Next Fld
 
    'Pour chaque propriete
    For Each Prp In RltSource.Properties
        'copier la propriété s'il ne s'agit pas du nom
        If Prp.Name <> "Name" Then
            EcrirePropriete Prp, Rlt
        End If
    Next Prp
 
    'Ajoute la relation
    DbDest.Relations.Append Rlt
 
    Exit Sub
err:
End Sub

C'est donc la méthode "Exporter()" que j'appelle à partir d'un appui sur un bouton de formulaire.

Mon but est donc d'avoir un fonctionnement automatisé et pas forcément spécifique à cette application... Je pense que ça pourrait en aider plus d'un

En espérant avoir été clair et que quelqu'un soit en mesure de m'aider... A vrai dire je commence à dessespérer !

Merci d'avance pour votre aide