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 |
