Discussion :

[voxov]

Bonjour.

Je cherche une solution pour créer le code VBA d'une base existante.

C'est l'équivalent en VBA du DDL en SQL (create table ...).
Le but est d'obtenir le code qui permet de regénérer la base Access.
Le code doit être du VBA, pour pouvoir être exécuté depuis une base Access vide.

Il existe des data modelers qui, au départ d'un modèle physique de données, génèrent le code VBA qui permet ensuite la création de la base en Access. On met le code VBA dans un module dans une base vide et on l'exécute. Quand c'est terminé, on a les tables avec les clés primaires, les index, les contraintes d'intégrité et tout le reste.
Mais ici, il s'agit de générer ce code VBA depuis la base Access existante.

A quoi ça peut servir ?
Ca sert à avoir dans un fichier texte tout ce qu'il faut pour recréer la base de données (sans les données, bien évidemment).

Merci d'avance pour vos idées, suggestions et solutions.

[User]

Bonsoir,

Pourquoi ne pas utiliser l'outil Access pour importer des objets d'une autre base (données externes...), au lieu d'utiliser VBA ?

Cdlt,

[voxov]

Parce que dans mon cas, je dois pouvoir transférer une base Access via fichier txt.
Transférer la base elle-même est proscrit.
Transférer d'une base Access vers une autre base Access n'est pas la solution, dans mon cas.

[loufab]

Bonjour,

Il y a 2 commandes pour tout ce qui n'est pas table, Relation, query :

SaveAsText et LoadFromText

Voici une discussion sur le SaveAsText :

https://www.developpez.net/forums/d1...on-saveastext/

Cordialement,

[Thumb down]

Bonjour,
si ça peut t'apporter un début de solution!
https://www.developpez.net/forums/d2.../#post11867532

[voxov]

Merci Thump down.
La solution n'y est pas, mais il y a peut-être une idée pour une partie de la solution

Pour recréer par un script VBA une base Access existante, il faut parcourir les objets de la base Access d'origine et les prendre un par un, du premier jusqu'au dernier.
Pour chacun des objets, il faut lire une par une les propriétés de l'objet (dans la base Access d'origine) et écrire un morceau de script VBA pour la recréer plus tard dans la nouvelle base Access. En fait, c'est traduire les objets de la base Access en VBA.

ex. pour créer une colonne dans une table:

Code :

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

Call AddFieldToTable("Personne", "Nom", adVarWChar, 50, 0, "", "TRUE", "", "", "", "", "")

donc, 2 challenges différents:
1. lire la structure de la base Access (objets et propriétés)
2. écrire du script VBA qui recrée ces objets et propriétés

J'espère avoir un peu clarifié les choses.
Je pense que cela exige des connaissances pointues tant dans le modèle des objets Access que dans le VBA.

[Thumb down]

Bonjour,
Tu copies ce code dans notpad++ et tu l'enregistres avec l'extension "VBS"
J'ai imaginé que tu avais outlook.

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
Option Explicit
 
 
' Fonction pour copier une base de données Access sous un autre nom
Function CopyAccessDatabase(sourcePath, destinationPath)
    Dim fs, sourceFile, destinationFile
    Set fs = CreateObject("Scripting.FileSystemObject")
 
    ' Vérifier si le fichier source existe
    If fs.FileExists(sourcePath) Then
        ' Copier le fichier source vers la destination
        fs.CopyFile sourcePath, destinationPath
        CopyAccessDatabase = True
    Else
        ' Afficher un message d'erreur si le fichier source n'existe pas
        WScript.Echo "Le fichier source n'existe pas."
        CopyAccessDatabase = False
    End If
End Function
 
' Fonction pour récupérer la liste ordonnée des tables en tenant compte des dépendances
Function GetOrderedTables(databasePath)
    Dim accessApp, db, table, i, dependencies, orderedTables
    Set accessApp = CreateObject("Access.Application")
    accessApp.Visible = False
 
    ' Ouvrir la base de données
    accessApp.OpenCurrentDatabase databasePath
 
    ' Initialiser la liste ordonnée des tables
    Set orderedTables = CreateObject("Scripting.Dictionary")
 
    ' Récupérer les dépendances entre les tables
    Set dependencies = accessApp.CurrentDb.TableDefs.GetDependencies
 
    ' Parcourir les dépendances pour obtenir l'ordre de traitement des tables
    For i = 0 To dependencies.Count - 1
        orderedTables(dependencies(i).Table) = True
    Next
 
    ' Ajouter toutes les tables restantes dans l'ordre
    For i = 0 To accessApp.CurrentDb.TableDefs.Count - 1
        Set table = accessApp.CurrentDb.TableDefs(i)
        If Left(table.Name, 4) <> "MSys" And Not orderedTables.Exists(table.Name) Then
            orderedTables(table.Name) = True
        End If
    Next
 
    ' Fermer la base de données
    accessApp.CloseCurrentDatabase
    accessApp.Quit
 
    Set accessApp = Nothing
 
    ' Retourner la liste ordonnée des tables
    GetOrderedTables = orderedTables.Keys
End Function
 
' Fonction pour effacer le contenu des tables sans supprimer les tables elles-mêmes
Sub ClearTableData(databasePath)
    Dim accessApp, db, table, tableName
    Set accessApp = CreateObject("Access.Application")
    accessApp.Visible = False
 
    ' Ouvrir la base de données
    accessApp.OpenCurrentDatabase databasePath
 
    ' Récupérer la liste ordonnée des tables en tenant compte des dépendances
    Dim orderedTables
    orderedTables = GetOrderedTables(databasePath)
 
    ' Effacer le contenu des tables dans l'ordre approprié
    For Each tableName In orderedTables
        accessApp.CurrentDb.Execute "DELETE * FROM " & tableName
    Next
 
    ' Compacter la base de données
    accessApp.CurrentDb.Execute "CompactDatabase"
 
    ' Fermer la base de données
    accessApp.CloseCurrentDatabase
    accessApp.Quit
 
    Set accessApp = Nothing
End Sub
 
' Fonction pour encoder un fichier en Base64
Function EncodeBase64(filePath)
    Dim inputStream, outputStream, xmlDoc
    Set inputStream = CreateObject("ADODB.Stream")
    inputStream.Open
    inputStream.Type = 1 ' adTypeBinary
    inputStream.LoadFromFile filePath
 
    Set outputStream = CreateObject("ADODB.Stream")
    outputStream.Open
    outputStream.Type = 1 ' adTypeBinary
    outputStream.Charset = "utf-8"
    outputStream.WriteTo outputStream
    outputStream.Position = 0
    outputStream.Type = 2 ' adTypeText
    outputStream.Charset = "utf-8"
    outputStream.Base64Encode
 
    EncodeBase64 = outputStream.ReadText
End Function
 
' Sélectionner le fichier Access
Function SelectAccessFile()
    Dim fileDialog, selectedFile
    Set fileDialog = CreateObject("WScript.Shell").BrowseForFolder(0, "Sélectionnez la base de données Access", 0, "")
    If Not fileDialog Is Nothing Then
        selectedFile = fileDialog.Items.Item().Path
        If Right(selectedFile, 4) = ".accdb" Or Right(selectedFile, 4) = ".mdb" Then
            SelectAccessFile = selectedFile
        Else
            WScript.Echo "Veuillez sélectionner un fichier Access (.accdb ou .mdb)."
            SelectAccessFile = ""
        End If
    Else
        WScript.Echo "Aucun fichier sélectionné."
        SelectAccessFile = ""
    End If
End Function
 
' Fonction pour créer et afficher un e-mail avec le contenu de la base de données encodée en Base64
Sub SendEmail(encodedDatabase)
    Dim outlookApp, mailItem
    Set outlookApp = CreateObject("Outlook.Application")
    Set mailItem = outlookApp.CreateItem(0) ' 0 pour un nouvel e-mail
 
    ' Remplir les détails de l'e-mail
    mailItem.Subject = "Base de données Access encodée"
    mailItem.Body = "Voici le contenu de la base de données encodée en Base64 : " & vbCrLf & vbCrLf & encodedDatabase
    mailItem.Display ' Afficher l'e-mail pour que l'utilisateur puisse le modifier et l'envoyer manuellement
End Sub
 
' Début du script principal
 
Dim sourceFile, destinationFile, databasePath, encodedDatabase
 
' Sélectionner la base de données Access
databasePath = SelectAccessFile()
 
If databasePath <> "" Then
    ' Copier la base de données sous un nouveau nom
    destinationFile = Replace(databasePath, ".accdb", "_copie.accdb")
    destinationFile = Replace(destinationFile, ".mdb", "_copie.mdb")
    If CopyAccessDatabase(databasePath, destinationFile) Then
        ' Effacer le contenu des tables en tenant compte des dépendances
        ClearTableData destinationFile
 
        ' Encoder la base de données en Base64
        encodedDatabase = EncodeBase64(destinationFile)
 
        ' Afficher la base de données encodée dans le corps d'un e-mail Outlook
        SendEmail encodedDatabase
    Else
        WScript.Echo "La copie de la base de données a échoué."
    End If
End If

[voxov]

Bonjour Thump down.
Merci pour le code.
Je n'utilise pas Outlook sur la machine perso, pour le tester, mais je vais regarder à ta solution.
En tout cas un grand merci pour ta proposition.