J'ai 1 base B1 avec des tables T1 à T3 vide pour avoir 1 structure pré
établie.
J'ai également 1 d'autres bases B2,B3 à Bn... avec certaines mêmes tables T1
à T3 où j'insère au fure et à mesure mes données.
Suite à modification de la structure des table T1 à T3 dans la base B1
(exemples : ajout d'1 champ à la fin, changement d'1 type de champ Octet en
Entier...), je souhaite mettre à jour automatiquement la structure des
autres bases sans perdre les données.
J'ai donc pensé ceci : programmer 1 morceau de code dans 1 base neutre qui
accède aux différentes bases :
ouvrir chaque base B2 à Bn pour renommer la table T1 à T3 en T1-old à T3-old
copier la table T1 à T3 de la base B1 dans chaque base B2 à Bn
copier dans chaque base B2 à Bn les données de T1-old dà T3-old ans la
nouvelle table T1 à T3 vide.
J'ai donc commencé ceci, mais je dois me mélanger les pinceaux :
Option Compare Database
Option Explicit
Private Sub correcteur_Click()
On Error GoTo Err_correcteur_Click
Dim fd1 As FileDialog
Dim nomfichier1 As String
Dim fd As FileDialog
Dim nomfichierdata As Variant
Dim db As DAO.Database
' Sélection de la base 1
Set fd1 = Application.FileDialog(msoFileDialogFilePicker)
With fdvide
.Filters.Clear
.AllowMultiSelect = False
.InitialFileName = "B1.mdb"
' .title "Sélectionner la base 1"
'title n'ai pas reconnu... doit me manquer 1 dll... si vous avez également 1
réponse à ce pb sans gravité
If .Show = -1 Then
nomfichier1 = .SelectedItems(1)
If Right(nomfichier1, 6) <> "B1.mdb" Then
MsgBox "Recommencer et choisir la base vide"
Exit Sub
End If
Else
Exit Sub
End If
End With
' Sélection des autres bases B2_data à Bn_data
Set fd = Application.FileDialog(msoFileDialogFilePicker)
With fd
.Filters.Clear
.AllowMultiSelect = True
.InitialFileName = "*_data.mdb"
' .title "Sélectionner les datas (sélection multiple possible)"
If .Show = -1 Then
For Each nomfichierdata In .SelectedItems
'ouvre chaque bdd
Set db = DBEngine.Workspaces(0).OpenDatabase(nomfichierdata)
'renomme la table en -old (certaines bases n'ont pas toutes les tables)
On Error Resume Next
DoCmd.Rename "T1-old", acTable, "T1"
DoCmd.Rename "T2-old", acTable, "T2"
DoCmd.Rename "T3-old", acTable, "T3"
On Error GoTo 0
'apparement, le rename ne fonctionne pas.. car elle doit s'effectuer dans la
base en cours (qui contient uniquement ce code)
'je n'arrive pas a trouver de code qui permette de renommer en utilisant
l'objet db de la base ouverte ci-dessus par la commande opendatabase
'ferme la bdd et passe a la suivante
Set db = Nothing
Next
'ouvre la bdd1
Set db = DBEngine.Workspaces(0).OpenDatabase(nomfichier1)
For Each nomfichierdata In .SelectedItems
'copie les tables dans chaque bdd
DoCmd.CopyObject nomfichierdata, acTable, "T1"
DoCmd.CopyObject nomfichierdata, acTable, "T2
DoCmd.CopyObject nomfichierdata, acTable, "T3
' n'a pas l'air de bien fonctionner non plus pour la même raison cité à
peine plus haut
Next
Else
Exit Sub
End If
End With
Exit_correcteur_Click:
Set db = Nothing
Set fd = Nothing
Set fd1 = Nothing
