Je suis impliqué dans la mise à jour d'une solution Access. Il contient une bonne quantité de VBA, un certain nombre de requêtes, un petit nombre de tables et quelques formulaires pour la saisie de données et la génération de rapports. C'est un candidat idéal pour Access.
Je souhaite apporter des modifications à la conception de la table, à la VBA, aux requêtes et aux formulaires. Comment suivre mes modifications avec le contrôle de version? (Nous utilisons Subversion, mais cela convient à tous les goûts) Je peux coller toute la mdb dans Subversion, mais cela stockera un fichier binaire et je ne pourrai pas dire que je viens de changer une ligne de code VBA.
J'ai envisagé de copier le code VBA pour séparer les fichiers et de les enregistrer, mais je pouvais voir ceux-ci se désynchroniser rapidement avec ce qui se trouvait dans la base de données.
Nous avons écrit notre propre script en VBScript, qui utilise Application.SaveAsText () non documenté dans Access pour exporter tous les modules de code, de formulaire, de macro et de rapport. Ça y est, ça devrait vous donner des indications. (Attention: certains messages sont en allemand, mais vous pouvez facilement changer cela.)
EDIT: Pour résumer les divers commentaires ci-dessous: Notre projet suppose un fichier .adp. Pour obtenir ce travail avec .mdb/.accdb, vous devez remplacer OpenAccessProject () par OpenCurrentDatabase ().. (Mise à jour pour utiliser OpenAccessProject()
si une extension .adp est détectée, sinon utilisez OpenCurrentDatabase()
.)
decompose.vbs:
' Usage:
' CScript decompose.vbs <input file> <path>
' Converts all modules, classes, forms and macros from an Access Project file (.adp) <input file> to
' text and saves the results in separate files to <path>. Requires Microsoft Access.
'
Option Explicit
const acForm = 2
const acModule = 5
const acMacro = 4
const acReport = 3
' BEGIN CODE
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
dim sADPFilename
If (WScript.Arguments.Count = 0) then
MsgBox "Bitte den Dateinamen angeben!", vbExclamation, "Error"
Wscript.Quit()
End if
sADPFilename = fso.GetAbsolutePathName(WScript.Arguments(0))
Dim sExportpath
If (WScript.Arguments.Count = 1) then
sExportpath = ""
else
sExportpath = WScript.Arguments(1)
End If
exportModulesTxt sADPFilename, sExportpath
If (Err <> 0) and (Err.Description <> NULL) Then
MsgBox Err.Description, vbExclamation, "Error"
Err.Clear
End If
Function exportModulesTxt(sADPFilename, sExportpath)
Dim myComponent
Dim sModuleType
Dim sTempname
Dim sOutstring
dim myType, myName, myPath, sStubADPFilename
myType = fso.GetExtensionName(sADPFilename)
myName = fso.GetBaseName(sADPFilename)
myPath = fso.GetParentFolderName(sADPFilename)
If (sExportpath = "") then
sExportpath = myPath & "\Source\"
End If
sStubADPFilename = sExportpath & myName & "_stub." & myType
WScript.Echo "copy stub to " & sStubADPFilename & "..."
On Error Resume Next
fso.CreateFolder(sExportpath)
On Error Goto 0
fso.CopyFile sADPFilename, sStubADPFilename
WScript.Echo "starting Access..."
Dim oApplication
Set oApplication = CreateObject("Access.Application")
WScript.Echo "opening " & sStubADPFilename & " ..."
If (Right(sStubADPFilename,4) = ".adp") Then
oApplication.OpenAccessProject sStubADPFilename
Else
oApplication.OpenCurrentDatabase sStubADPFilename
End If
oApplication.Visible = false
dim dctDelete
Set dctDelete = CreateObject("Scripting.Dictionary")
WScript.Echo "exporting..."
Dim myObj
For Each myObj In oApplication.CurrentProject.AllForms
WScript.Echo " " & myObj.fullname
oApplication.SaveAsText acForm, myObj.fullname, sExportpath & "\" & myObj.fullname & ".form"
oApplication.DoCmd.Close acForm, myObj.fullname
dctDelete.Add "FO" & myObj.fullname, acForm
Next
For Each myObj In oApplication.CurrentProject.AllModules
WScript.Echo " " & myObj.fullname
oApplication.SaveAsText acModule, myObj.fullname, sExportpath & "\" & myObj.fullname & ".bas"
dctDelete.Add "MO" & myObj.fullname, acModule
Next
For Each myObj In oApplication.CurrentProject.AllMacros
WScript.Echo " " & myObj.fullname
oApplication.SaveAsText acMacro, myObj.fullname, sExportpath & "\" & myObj.fullname & ".mac"
dctDelete.Add "MA" & myObj.fullname, acMacro
Next
For Each myObj In oApplication.CurrentProject.AllReports
WScript.Echo " " & myObj.fullname
oApplication.SaveAsText acReport, myObj.fullname, sExportpath & "\" & myObj.fullname & ".report"
dctDelete.Add "RE" & myObj.fullname, acReport
Next
WScript.Echo "deleting..."
dim sObjectname
For Each sObjectname In dctDelete
WScript.Echo " " & Mid(sObjectname, 3)
oApplication.DoCmd.DeleteObject dctDelete(sObjectname), Mid(sObjectname, 3)
Next
oApplication.CloseCurrentDatabase
oApplication.CompactRepair sStubADPFilename, sStubADPFilename & "_"
oApplication.Quit
fso.CopyFile sStubADPFilename & "_", sStubADPFilename
fso.DeleteFile sStubADPFilename & "_"
End Function
Public Function getErr()
Dim strError
strError = vbCrLf & "----------------------------------------------------------------------------------------------------------------------------------------" & vbCrLf & _
"From " & Err.source & ":" & vbCrLf & _
" Description: " & Err.Description & vbCrLf & _
" Code: " & Err.Number & vbCrLf
getErr = strError
End Function
Si vous avez besoin d’une commande cliquable, au lieu d’utiliser la ligne de commande, créez un fichier nommé "decompose.cmd" avec
cscript decompose.vbs youraccessapplication.adp
Par défaut, tous les fichiers exportés sont placés dans un sous-dossier "Scripts" de votre application Access. Le fichier .adp/mdb est également copié à cet emplacement (avec un suffixe "stub") et supprimé de tous les modules exportés, ce qui le rend vraiment petit.
Vous DEVEZ archiver ce fichier de remplacement avec les fichiers source, car la plupart des paramètres d'accès et des barres de menus personnalisées ne peuvent pas être exportés autrement. Veillez simplement à valider les modifications apportées à ce fichier uniquement, si vous avez réellement modifié certains paramètres ou menus.
Remarque: Si vous avez des Autoexec-Makros définis dans votre application, vous devrez peut-être maintenir la touche Maj enfoncée lorsque vous appelez la décomposition pour l'empêcher de s'exécuter et d'interférer avec l'exportation!
Bien sûr, il y a aussi le script inverse, pour construire l'application à partir du répertoire "Source":
compose.vbs:
' Usage:
' WScript compose.vbs <file> <path>
' Converts all modules, classes, forms and macros in a directory created by "decompose.vbs"
' and composes then into an Access Project file (.adp). This overwrites any existing Modules with the
' same names without warning!!!
' Requires Microsoft Access.
Option Explicit
const acForm = 2
const acModule = 5
const acMacro = 4
const acReport = 3
Const acCmdCompileAndSaveAllModules = &H7E
' BEGIN CODE
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
dim sADPFilename
If (WScript.Arguments.Count = 0) then
MsgBox "Please enter the file name!", vbExclamation, "Error"
Wscript.Quit()
End if
sADPFilename = fso.GetAbsolutePathName(WScript.Arguments(0))
Dim sPath
If (WScript.Arguments.Count = 1) then
sPath = ""
else
sPath = WScript.Arguments(1)
End If
importModulesTxt sADPFilename, sPath
If (Err <> 0) and (Err.Description <> NULL) Then
MsgBox Err.Description, vbExclamation, "Error"
Err.Clear
End If
Function importModulesTxt(sADPFilename, sImportpath)
Dim myComponent
Dim sModuleType
Dim sTempname
Dim sOutstring
' Build file and pathnames
dim myType, myName, myPath, sStubADPFilename
myType = fso.GetExtensionName(sADPFilename)
myName = fso.GetBaseName(sADPFilename)
myPath = fso.GetParentFolderName(sADPFilename)
' if no path was given as argument, use a relative directory
If (sImportpath = "") then
sImportpath = myPath & "\Source\"
End If
sStubADPFilename = sImportpath & myName & "_stub." & myType
' check for existing file and ask to overwrite with the stub
if (fso.FileExists(sADPFilename)) Then
WScript.StdOut.Write sADPFilename & " exists. Overwrite? (y/n) "
dim sInput
sInput = WScript.StdIn.Read(1)
if (sInput <> "y") Then
WScript.Quit
end if
fso.CopyFile sADPFilename, sADPFilename & ".bak"
end if
fso.CopyFile sStubADPFilename, sADPFilename
' launch MSAccess
WScript.Echo "starting Access..."
Dim oApplication
Set oApplication = CreateObject("Access.Application")
WScript.Echo "opening " & sADPFilename & " ..."
If (Right(sStubADPFilename,4) = ".adp") Then
oApplication.OpenAccessProject sADPFilename
Else
oApplication.OpenCurrentDatabase sADPFilename
End If
oApplication.Visible = false
Dim folder
Set folder = fso.GetFolder(sImportpath)
' load each file from the import path into the stub
Dim myFile, objectname, objecttype
for each myFile in folder.Files
objecttype = fso.GetExtensionName(myFile.Name)
objectname = fso.GetBaseName(myFile.Name)
WScript.Echo " " & objectname & " (" & objecttype & ")"
if (objecttype = "form") then
oApplication.LoadFromText acForm, objectname, myFile.Path
elseif (objecttype = "bas") then
oApplication.LoadFromText acModule, objectname, myFile.Path
elseif (objecttype = "mac") then
oApplication.LoadFromText acMacro, objectname, myFile.Path
elseif (objecttype = "report") then
oApplication.LoadFromText acReport, objectname, myFile.Path
end if
next
oApplication.RunCommand acCmdCompileAndSaveAllModules
oApplication.Quit
End Function
Public Function getErr()
Dim strError
strError = vbCrLf & "----------------------------------------------------------------------------------------------------------------------------------------" & vbCrLf & _
"From " & Err.source & ":" & vbCrLf & _
" Description: " & Err.Description & vbCrLf & _
" Code: " & Err.Number & vbCrLf
getErr = strError
End Function
Encore une fois, cela va avec un compagnon "compose.cmd" contenant:
cscript compose.vbs youraccessapplication.adp
Il vous demande de confirmer le remplacement de votre application actuelle et crée d'abord une sauvegarde, si vous le faites. Il collecte ensuite tous les fichiers source du répertoire source et les réinsère dans le stub.
S'amuser!
Cela semble être quelque chose de tout à fait disponible dans Access:
Ce link from msdn explique comment installer un complément de contrôle de source pour Microsoft Access. Ce logiciel est fourni en téléchargement gratuit dans le cadre des extensions pour développeur Access pour Access 2007 et en tant que complément gratuit distinct pour Access 2003.
Je suis heureux que vous ayez posé cette question et j'ai pris le temps de l'examiner, car j'aimerais aussi avoir cette possibilité. Le lien ci-dessus contient plus d'informations à ce sujet et des liens vers les compléments.
Mettre à jour:
J'ai installé le complément pour Access 2003. Il ne fonctionnera qu'avec VSS, mais il me permet de placer des objets Access (formulaires, requêtes, tableaux, modules, etc.) dans le référentiel. Lorsque vous modifiez un élément du référentiel, vous êtes invité à le vérifier, mais ce n'est pas obligatoire. Ensuite, je vais vérifier comment il gère son ouverture et sa modification sur des systèmes sans le complément. Je ne suis pas un fan de VSS, mais j'aime beaucoup l'idée de stocker des objets d'accès dans un repo.
Update2:
Les ordinateurs sans complément ne sont pas en mesure d’apporter des modifications à la structure de la base de données (ajout de champs de table, de paramètres de requête, etc.). Au début, je pensais que cela pourrait poser un problème si quelqu'un en avait besoin, car il n'y avait aucun moyen apparent de supprimer la base de données Access du contrôle de source si le complément n'avait pas été chargé.
Id a découvert que l'exécution de la base de données "compacte et réparée" vous demandait si vous souhaitez supprimer la base de données du contrôle de source. J'ai choisi oui et j'ai pu modifier la base de données sans le complément. L'article dans link ci-dessus donne également des instructions pour configurer Access 2003 et 2007 afin d'utiliser Team System. Si vous pouvez trouver un fournisseur MSSCCI pour SVN, il y a de bonnes chances que cela fonctionne.
Olivers réponds, mais la référence CurrentProject
ne fonctionnait pas pour moi. J'ai fini par arracher les tripes du milieu de son exportation pour le remplacer par ceci, basé sur une solution similaire de Arvin Meyer . A l'avantage d'exporter des requêtes si vous utilisez un mdb au lieu d'un adp.
' Writes database componenets to a series of text files
' @author Arvin Meyer
' @date June 02, 1999
Function DocDatabase(oApp)
Dim dbs
Dim cnt
Dim doc
Dim i
Dim prefix
Dim dctDelete
Dim docName
Const acQuery = 1
Set dctDelete = CreateObject("Scripting.Dictionary")
Set dbs = oApp.CurrentDb() ' use CurrentDb() to refresh Collections
Set cnt = dbs.Containers("Forms")
prefix = oApp.CurrentProject.Path & "\"
For Each doc In cnt.Documents
oApp.SaveAsText acForm, doc.Name, prefix & doc.Name & ".frm"
dctDelete.Add "frm_" & doc.Name, acForm
Next
Set cnt = dbs.Containers("Reports")
For Each doc In cnt.Documents
oApp.SaveAsText acReport, doc.Name, prefix & doc.Name & ".rpt"
dctDelete.Add "rpt_" & doc.Name, acReport
Next
Set cnt = dbs.Containers("Scripts")
For Each doc In cnt.Documents
oApp.SaveAsText acMacro, doc.Name, prefix & doc.Name & ".vbs"
dctDelete.Add "vbs_" & doc.Name, acMacro
Next
Set cnt = dbs.Containers("Modules")
For Each doc In cnt.Documents
oApp.SaveAsText acModule, doc.Name, prefix & doc.Name & ".bas"
dctDelete.Add "bas_" & doc.Name, acModule
Next
For i = 0 To dbs.QueryDefs.Count - 1
oApp.SaveAsText acQuery, dbs.QueryDefs(i).Name, prefix & dbs.QueryDefs(i).Name & ".txt"
dctDelete.Add "qry_" & dbs.QueryDefs(i).Name, acQuery
Next
WScript.Echo "deleting " & dctDelete.Count & " objects."
For Each docName In dctDelete
WScript.Echo " " & Mid(docName, 5)
oApp.DoCmd.DeleteObject dctDelete(docName), Mid(docName, 5)
Next
Set doc = Nothing
Set cnt = Nothing
Set dbs = Nothing
Set dctDelete = Nothing
End Function
La solution de composition/décomposition publiée par Oliver est excellente, mais elle pose quelques problèmes:
J'avais prévu de résoudre ce problème moi-même, mais j'ai découvert qu'il existe déjà une bonne solution: timabell/msaccess-vcs-integration sur GitHub. J'ai testé msaccess-vcs-integration et cela fonctionne très bien.
Mis à jour le 3 mars 2015: Le projet était à l'origine géré par bkidwell on Github, mais il a été transféré vers timabell - le lien ci-dessus vers le projet est mis à jour en conséquence. Il y a quelques passages du projet original de bkidwell, par exemple de ArminBra et de matonb , pour lesquels AFAICT ne devrait pas être utilisé.
L'utilisation de msaccess-vcs-integration par rapport à la solution de décomposition d'Olivers présente les inconvénients suivants:
Quoi qu'il en soit, ma recommandation claire est msaccess-vcs-integration. Cela a résolu tous les problèmes que j'avais avec l'utilisation de Git sur les fichiers exportés.
Nous avons développé notre propre outil interne, où:
L'ensemble du système est suffisamment intelligent pour nous permettre de produire des versions "d'exécution" de notre application Access, générées automatiquement à partir de fichiers txt (modules et formulaires recréés avec la commande undocument application.loadFromText) et de fichiers mdb (tables).
Cela peut sembler étrange mais cela fonctionne.
Sur la base des idées de ce billet et d’entrées similaires dans certains blogs, j’ai écrit une application qui fonctionne avec les formats de fichier mdb et adp. Il importe/exporte tous les objets de la base de données (y compris les tables, les références, les relations et les propriétés de la base de données) dans des fichiers texte brut . Ces fichiers vous permettent de travailler avec un contrôle de version source. La prochaine version permettra d'importer les fichiers de texte brut dans la base de données. Il y aura aussi un outil de ligne de commande
Vous pouvez télécharger l'application ou le code source à partir de: http://accesssvn.codeplex.com/
cordialement
Ressusciter un vieux fil, mais celui-ci est bon. J'ai implémenté les deux scripts (compose.vbs/decompose.vbs) pour mon propre projet et j'ai rencontré un problème avec les anciens fichiers .mdb:
Il se bloque quand il arrive à un formulaire qui inclut le code:
NoSaveCTIWhenDisabled =1
Access dit qu'il y a un problème et c'est la fin de l'histoire. J'ai fait quelques tests et joué pour essayer de contourner ce problème et j'ai trouvé ce fil avec un travail à la fin:
Impossible de créer une base de données
Fondamentalement (au cas où le fil deviendrait inactif), prenez le fichier .mdb et effectuez un "Enregistrer sous" dans le nouveau format .accdb. Ensuite, le coffre source ou la composition/décomposition fonctionnera. J'ai également dû jouer pendant 10 minutes pour obtenir la bonne syntaxe de ligne de commande pour que les scripts (de) composition fonctionnent correctement. Voici donc ces informations également:
Pour composer (supposons que vos fichiers se trouvent dans C:\SControl (créez un sous-dossier nommé Source pour stocker les fichiers extraits):
'(to extract for importing to source control)
cscript compose.vbs database.accdb
'(to rebuild from extracted files saved from an earlier date)
cscript decompose.vbs database.accdb C:\SControl\Source\
C'est tout!
Les versions d'Access où j'ai rencontré le problème ci-dessus incluent les bases de données ".mdb" d'Access 2000-2003 et ont résolu le problème en les enregistrant aux formats ".accdb" 2007-2010 avant d'exécuter les scripts de composition/décomposition. Après la conversion, les scripts fonctionnent parfaitement!
J'ai modifié la paire de scripts d'Oliver afin qu'ils exportent/importent relations, tables et requêtes en plus de modules, classes, formulaires et macros. Tout est enregistré dans des fichiers en texte brut. No fichier de base de données est donc créé pour être stocké avec les fichiers texte dans le contrôle de version.
' Usage:
' cscript decompose.vbs <input file> <path>
' Converts all modules, classes, forms and macros from an Access Project file (.adp) <input file> to
' text and saves the results in separate files to <path>. Requires Microsoft Access.
Option Explicit
Const acForm = 2
Const acModule = 5
Const acMacro = 4
Const acReport = 3
Const acQuery = 1
Const acExportTable = 0
' BEGIN CODE
Dim fso, relDoc, ACCDBFilename, sExportpath
Set fso = CreateObject("Scripting.FileSystemObject")
Set relDoc = CreateObject("Microsoft.XMLDOM")
If (Wscript.Arguments.Count = 0) Then
MsgBox "Please provide the .accdb database file", vbExclamation, "Error"
Wscript.Quit()
End If
ACCDBFilename = fso.GetAbsolutePathName(Wscript.Arguments(0))
If (Wscript.Arguments.Count = 1) Then
sExportpath = ""
Else
sExportpath = Wscript.Arguments(1)
End If
exportModulesTxt ACCDBFilename, sExportpath
If (Err <> 0) And (Err.Description <> Null) Then
MsgBox Err.Description, vbExclamation, "Error"
Err.Clear
End If
Function exportModulesTxt(ACCDBFilename, sExportpath)
Dim myComponent, sModuleType, sTempname, sOutstring
Dim myType, myName, myPath, hasRelations
myType = fso.GetExtensionName(ACCDBFilename)
myName = fso.GetBaseName(ACCDBFilename)
myPath = fso.GetParentFolderName(ACCDBFilename)
'if no path was given as argument, use a relative directory
If (sExportpath = "") Then
sExportpath = myPath & "\Source"
End If
'On Error Resume Next
fso.DeleteFolder (sExportpath)
fso.CreateFolder (sExportpath)
On Error GoTo 0
Wscript.Echo "starting Access..."
Dim oApplication
Set oApplication = CreateObject("Access.Application")
Wscript.Echo "Opening " & ACCDBFilename & " ..."
If (Right(ACCDBFilename, 4) = ".adp") Then
oApplication.OpenAccessProject ACCDBFilename
Else
oApplication.OpenCurrentDatabase ACCDBFilename
End If
oApplication.Visible = False
Wscript.Echo "exporting..."
Dim myObj
For Each myObj In oApplication.CurrentProject.AllForms
Wscript.Echo "Exporting FORM " & myObj.FullName
oApplication.SaveAsText acForm, myObj.FullName, sExportpath & "\" & myObj.FullName & ".form.txt"
oApplication.DoCmd.Close acForm, myObj.FullName
Next
For Each myObj In oApplication.CurrentProject.AllModules
Wscript.Echo "Exporting MODULE " & myObj.FullName
oApplication.SaveAsText acModule, myObj.FullName, sExportpath & "\" & myObj.FullName & ".module.txt"
Next
For Each myObj In oApplication.CurrentProject.AllMacros
Wscript.Echo "Exporting MACRO " & myObj.FullName
oApplication.SaveAsText acMacro, myObj.FullName, sExportpath & "\" & myObj.FullName & ".macro.txt"
Next
For Each myObj In oApplication.CurrentProject.AllReports
Wscript.Echo "Exporting REPORT " & myObj.FullName
oApplication.SaveAsText acReport, myObj.FullName, sExportpath & "\" & myObj.FullName & ".report.txt"
Next
For Each myObj In oApplication.CurrentDb.QueryDefs
Wscript.Echo "Exporting QUERY " & myObj.Name
oApplication.SaveAsText acQuery, myObj.Name, sExportpath & "\" & myObj.Name & ".query.txt"
Next
For Each myObj In oApplication.CurrentDb.TableDefs
If Not Left(myObj.Name, 4) = "MSys" Then
Wscript.Echo "Exporting TABLE " & myObj.Name
oApplication.ExportXml acExportTable, myObj.Name, , sExportpath & "\" & myObj.Name & ".table.txt"
'put the file path as a second parameter if you want to export the table data as well, instead of ommiting it and passing it into a third parameter for structure only
End If
Next
hasRelations = False
relDoc.appendChild relDoc.createElement("Relations")
For Each myObj In oApplication.CurrentDb.Relations 'loop though all the relations
If Not Left(myObj.Name, 4) = "MSys" Then
Dim relName, relAttrib, relTable, relFoTable, fld
hasRelations = True
relDoc.ChildNodes(0).appendChild relDoc.createElement("Relation")
Set relName = relDoc.createElement("Name")
relName.Text = myObj.Name
relDoc.ChildNodes(0).LastChild.appendChild relName
Set relAttrib = relDoc.createElement("Attributes")
relAttrib.Text = myObj.Attributes
relDoc.ChildNodes(0).LastChild.appendChild relAttrib
Set relTable = relDoc.createElement("Table")
relTable.Text = myObj.Table
relDoc.ChildNodes(0).LastChild.appendChild relTable
Set relFoTable = relDoc.createElement("ForeignTable")
relFoTable.Text = myObj.ForeignTable
relDoc.ChildNodes(0).LastChild.appendChild relFoTable
Wscript.Echo "Exporting relation " & myObj.Name & " between tables " & myObj.Table & " -> " & myObj.ForeignTable
For Each fld In myObj.Fields 'in case the relationship works with more fields
Dim lf, ff
relDoc.ChildNodes(0).LastChild.appendChild relDoc.createElement("Field")
Set lf = relDoc.createElement("Name")
lf.Text = fld.Name
relDoc.ChildNodes(0).LastChild.LastChild.appendChild lf
Set ff = relDoc.createElement("ForeignName")
ff.Text = fld.ForeignName
relDoc.ChildNodes(0).LastChild.LastChild.appendChild ff
Wscript.Echo " Involving fields " & fld.Name & " -> " & fld.ForeignName
Next
End If
Next
If hasRelations Then
relDoc.InsertBefore relDoc.createProcessingInstruction("xml", "version='1.0'"), relDoc.ChildNodes(0)
relDoc.Save sExportpath & "\relations.rel.txt"
Wscript.Echo "Relations successfuly saved in file relations.rel.txt"
End If
oApplication.CloseCurrentDatabase
oApplication.Quit
End Function
Vous pouvez exécuter ce script en appelant cscript decompose.vbs <path to file to decompose> <folder to store text files>
. Si vous omettez le deuxième paramètre, le dossier "Source" sera créé dans lequel se trouve la base de données. Veuillez noter que le dossier de destination sera effacé s'il existe déjà.
Remplacez la ligne 93: oApplication.ExportXML acExportTable, myObj.Name, , sExportpath & "\" & myObj.Name & ".table.txt"
avec la ligne oApplication.ExportXML acExportTable, myObj.Name, sExportpath & "\" & myObj.Name & ".table.txt"
' Usage:
' cscript compose.vbs <file> <path>
' Reads all modules, classes, forms, macros, queries, tables and their relationships in a directory created by "decompose.vbs"
' and composes then into an Access Database file (.accdb).
' Requires Microsoft Access.
Option Explicit
Const acForm = 2
Const acModule = 5
Const acMacro = 4
Const acReport = 3
Const acQuery = 1
Const acStructureOnly = 0 'change 0 to 1 if you want import StructureAndData instead of StructureOnly
Const acCmdCompileAndSaveAllModules = &H7E
Dim fso, relDoc, ACCDBFilename, sPath
Set fso = CreateObject("Scripting.FileSystemObject")
Set relDoc = CreateObject("Microsoft.XMLDOM")
If (Wscript.Arguments.Count = 0) Then
MsgBox "Please provide the .accdb database file", vbExclamation, "Error"
Wscript.Quit()
End If
ACCDBFilename = fso.GetAbsolutePathName(Wscript.Arguments(0))
If (Wscript.Arguments.Count = 1) Then
sPath = ""
Else
sPath = Wscript.Arguments(1)
End If
importModulesTxt ACCDBFilename, sPath
If (Err <> 0) And (Err.Description <> Null) Then
MsgBox Err.Description, vbExclamation, "Error"
Err.Clear
End If
Function importModulesTxt(ACCDBFilename, sImportpath)
Dim myComponent, sModuleType, sTempname, sOutstring
' Build file and pathnames
Dim myType, myName, myPath
myType = fso.GetExtensionName(ACCDBFilename)
myName = fso.GetBaseName(ACCDBFilename)
myPath = fso.GetParentFolderName(ACCDBFilename)
' if no path was given as argument, use a relative directory
If (sImportpath = "") Then
sImportpath = myPath & "\Source\"
End If
' check for existing file and ask to overwrite with the stub
If fso.FileExists(ACCDBFilename) Then
Wscript.StdOut.Write ACCDBFilename & " already exists. Overwrite? (y/n) "
Dim sInput
sInput = Wscript.StdIn.Read(1)
If (sInput <> "y") Then
Wscript.Quit
Else
If fso.FileExists(ACCDBFilename & ".bak") Then
fso.DeleteFile (ACCDBFilename & ".bak")
End If
fso.MoveFile ACCDBFilename, ACCDBFilename & ".bak"
End If
End If
Wscript.Echo "starting Access..."
Dim oApplication
Set oApplication = CreateObject("Access.Application")
Wscript.Echo "Opening " & ACCDBFilename
If (Right(ACCDBFilename, 4) = ".adp") Then
oApplication.CreateAccessProject ACCDBFilename
Else
oApplication.NewCurrentDatabase ACCDBFilename
End If
oApplication.Visible = False
Dim folder
Set folder = fso.GetFolder(sImportpath)
'load each file from the import path into the stub
Dim myFile, objectname, objecttype
For Each myFile In folder.Files
objectname = fso.GetBaseName(myFile.Name) 'get rid of .txt extension
objecttype = fso.GetExtensionName(objectname)
objectname = fso.GetBaseName(objectname)
Select Case objecttype
Case "form"
Wscript.Echo "Importing FORM from file " & myFile.Name
oApplication.LoadFromText acForm, objectname, myFile.Path
Case "module"
Wscript.Echo "Importing MODULE from file " & myFile.Name
oApplication.LoadFromText acModule, objectname, myFile.Path
Case "macro"
Wscript.Echo "Importing MACRO from file " & myFile.Name
oApplication.LoadFromText acMacro, objectname, myFile.Path
Case "report"
Wscript.Echo "Importing REPORT from file " & myFile.Name
oApplication.LoadFromText acReport, objectname, myFile.Path
Case "query"
Wscript.Echo "Importing QUERY from file " & myFile.Name
oApplication.LoadFromText acQuery, objectname, myFile.Path
Case "table"
Wscript.Echo "Importing TABLE from file " & myFile.Name
oApplication.ImportXml myFile.Path, acStructureOnly
Case "rel"
Wscript.Echo "Found RELATIONSHIPS file " & myFile.Name & " ... opening, it will be processed after everything else has been imported"
relDoc.Load (myFile.Path)
End Select
Next
If relDoc.readyState Then
Wscript.Echo "Preparing to build table dependencies..."
Dim xmlRel, xmlField, accessRel, relTable, relName, relFTable, relAttr, i
For Each xmlRel In relDoc.SelectNodes("/Relations/Relation") 'loop through every Relation node inside .xml file
relName = xmlRel.SelectSingleNode("Name").Text
relTable = xmlRel.SelectSingleNode("Table").Text
relFTable = xmlRel.SelectSingleNode("ForeignTable").Text
relAttr = xmlRel.SelectSingleNode("Attributes").Text
'remove any possible conflicting relations or indexes
On Error Resume Next
oApplication.CurrentDb.Relations.Delete (relName)
oApplication.CurrentDb.TableDefs(relTable).Indexes.Delete (relName)
oApplication.CurrentDb.TableDefs(relFTable).Indexes.Delete (relName)
On Error GoTo 0
Wscript.Echo "Creating relation " & relName & " between tables " & relTable & " -> " & relFTable
Set accessRel = oApplication.CurrentDb.CreateRelation(relName, relTable, relFTable, relAttr) 'create the relationship object
For Each xmlField In xmlRel.SelectNodes("Field") 'in case the relationship works with more fields
accessRel.Fields.Append accessRel.CreateField(xmlField.SelectSingleNode("Name").Text)
accessRel.Fields(xmlField.SelectSingleNode("Name").Text).ForeignName = xmlField.SelectSingleNode("ForeignName").Text
Wscript.Echo " Involving fields " & xmlField.SelectSingleNode("Name").Text & " -> " & xmlField.SelectSingleNode("ForeignName").Text
Next
oApplication.CurrentDb.Relations.Append accessRel 'append the newly created relationship to the database
Wscript.Echo " Relationship added"
Next
End If
oApplication.RunCommand acCmdCompileAndSaveAllModules
oApplication.Quit
End Function
Vous pouvez exécuter ce script en appelant cscript compose.vbs <path to file which should be created> <folder with text files>
. Si vous omettez le deuxième paramètre, il examinera le dossier «Source» dans lequel la base de données devrait être créée.
Remplacez la ligne 14: const acStructureOnly = 0
par const acStructureOnly = 1
. Cela ne fonctionnera que si vous avez inclus les données dans la table exportée.
Une de mes autres ressources en travaillant sur ce script était cette réponse , ce qui m’a aidé à comprendre comment exporter des relations.
Nous avons eu le même problème il y a un moment.
Notre premier essai était un outil tiers offrant un proxy de l'API SourceSafe pour Subversion à utiliser avec MS Access et VB 6. Vous pouvez trouver cet outil ici .
Comme nous n'étions pas satisfaits de cet outil, nous sommes passés à Visual SourceSafe et au plug-in VSS Acces.
SaveAsText n'est pas une méthode visible dans Intellisense pour les utilisateurs d'Access 2010, mais elle semble être une méthode valide, car le script mentionné précédemment d'Arvin Meyer a bien fonctionné pour moi.
Fait intéressant, SaveAsAXL est une nouveauté en 2010 et possède la même signature que SaveAsText, bien qu'il semble que cela ne fonctionne qu'avec les bases de données Web, qui nécessitent SharePoint Server 2010.
VSS 6.0 ne peut accepter les MDB qu'en utilisant le complément sous un certain nombre d'objets, ce qui inclut toutes les tables, requêtes, modules et formulaires locaux. Je ne connais pas la limite d'objet exacte.
Pour construire notre application Prod Floor, vieille de 10 ans, ce qui est énorme, nous sommes obligés de combiner 3 ou 4 banques de développement distinctes sur SS dans une seule BMD, ce qui complique la création automatisée au point de ne pas perdre de temps à le faire.
Je pense que je vais essayer le script ci-dessus pour cracher cette MDb dans SVN et simplifier les constructions pour tout le monde.
Vous pouvez également connecter votre MS Access à Team Foundation Server. Il existe également une variante Express gratuite pour un maximum de 5 développeurs. Fonctionne vraiment bien!
Edit: lien fixe
Pour être complet ...
Il y a toujours "Outils Visual Studio [ANNEE] pour Microsoft Office System" ( http://msdn.Microsoft.com/en-us/vs2005/aa718673.aspx ) mais cela semble nécessiter VSS. Pour moi, VSS (corruption automatique) est pire que mes 347 points de sauvegarde sur mon partage réseau sauvegardé.
J'utilise Oasis-Svn http://dev2dev.de/
Je peux juste dire que cela m'a sauvé au moins une fois. Mon mdb grandissait au-delà de 2 Go et cela l'a brisé. Je pouvais revenir à une ancienne version, importer les formulaires et perdre un jour ou deux de travail.
J'ai trouvé cet outil sur SourceForge: http://sourceforge.net/projects/avc/
Je ne l'ai pas utilisé, mais c'est peut-être un début pour vous. Il est possible que d’autres outils tiers s’intégrant à VSS ou à SVN répondent à vos besoins.
Personnellement, je conserve simplement un fichier texte en clair pour conserver un journal des modifications. Lorsque je valide la MDB binaire, j'utilise les entrées du journal des modifications comme commentaire de validation.
j'utilise le complément Access 2003: Contrôle de code source . Ça fonctionne bien. Un problème sont des caractères non valides comme un ":".
Je suis check in et out. En interne, l'add-in fait la même chose que le code, mais avec davantage de support pour les outils Je peux voir si un objet est extrait et actualiser les objets.
La réponse d'Oliver fonctionne très bien. Veuillez trouver ci-dessous ma version étendue qui ajoute la prise en charge des requêtes Access.
(veuillez voir la réponse d'Oliver pour plus d'informations/utilisation)
decompose.vbs:
' Usage:
' CScript decompose.vbs <input file> <path>
' Converts all modules, classes, forms and macros from an Access Project file (.adp) <input file> to
' text and saves the results in separate files to <path>. Requires Microsoft Access.
'
Option Explicit
const acForm = 2
const acModule = 5
const acMacro = 4
const acReport = 3
const acQuery = 1
' BEGIN CODE
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
dim sADPFilename
If (WScript.Arguments.Count = 0) then
MsgBox "Bitte den Dateinamen angeben!", vbExclamation, "Error"
Wscript.Quit()
End if
sADPFilename = fso.GetAbsolutePathName(WScript.Arguments(0))
Dim sExportpath
If (WScript.Arguments.Count = 1) then
sExportpath = ""
else
sExportpath = WScript.Arguments(1)
End If
exportModulesTxt sADPFilename, sExportpath
If (Err <> 0) and (Err.Description <> NULL) Then
MsgBox Err.Description, vbExclamation, "Error"
Err.Clear
End If
Function exportModulesTxt(sADPFilename, sExportpath)
Dim myComponent
Dim sModuleType
Dim sTempname
Dim sOutstring
dim myType, myName, myPath, sStubADPFilename
myType = fso.GetExtensionName(sADPFilename)
myName = fso.GetBaseName(sADPFilename)
myPath = fso.GetParentFolderName(sADPFilename)
If (sExportpath = "") then
sExportpath = myPath & "\Source\"
End If
sStubADPFilename = sExportpath & myName & "_stub." & myType
WScript.Echo "copy stub to " & sStubADPFilename & "..."
On Error Resume Next
fso.CreateFolder(sExportpath)
On Error Goto 0
fso.CopyFile sADPFilename, sStubADPFilename
WScript.Echo "starting Access..."
Dim oApplication
Set oApplication = CreateObject("Access.Application")
WScript.Echo "opening " & sStubADPFilename & " ..."
If (Right(sStubADPFilename,4) = ".adp") Then
oApplication.OpenAccessProject sStubADPFilename
Else
oApplication.OpenCurrentDatabase sStubADPFilename
End If
oApplication.Visible = false
dim dctDelete
Set dctDelete = CreateObject("Scripting.Dictionary")
WScript.Echo "exporting..."
Dim myObj
For Each myObj In oApplication.CurrentProject.AllForms
WScript.Echo " " & myObj.fullname
oApplication.SaveAsText acForm, myObj.fullname, sExportpath & "\" & myObj.fullname & ".form"
oApplication.DoCmd.Close acForm, myObj.fullname
dctDelete.Add "FO" & myObj.fullname, acForm
Next
For Each myObj In oApplication.CurrentProject.AllModules
WScript.Echo " " & myObj.fullname
oApplication.SaveAsText acModule, myObj.fullname, sExportpath & "\" & myObj.fullname & ".bas"
dctDelete.Add "MO" & myObj.fullname, acModule
Next
For Each myObj In oApplication.CurrentProject.AllMacros
WScript.Echo " " & myObj.fullname
oApplication.SaveAsText acMacro, myObj.fullname, sExportpath & "\" & myObj.fullname & ".mac"
dctDelete.Add "MA" & myObj.fullname, acMacro
Next
For Each myObj In oApplication.CurrentProject.AllReports
WScript.Echo " " & myObj.fullname
oApplication.SaveAsText acReport, myObj.fullname, sExportpath & "\" & myObj.fullname & ".report"
dctDelete.Add "RE" & myObj.fullname, acReport
Next
For Each myObj In oApplication.CurrentDb.QueryDefs
if not left(myObj.name,3) = "~sq" then 'exclude queries defined by the forms. Already included in the form itself
WScript.Echo " " & myObj.name
oApplication.SaveAsText acQuery, myObj.name, sExportpath & "\" & myObj.name & ".query"
oApplication.DoCmd.Close acQuery, myObj.name
dctDelete.Add "FO" & myObj.name, acQuery
end if
Next
WScript.Echo "deleting..."
dim sObjectname
For Each sObjectname In dctDelete
WScript.Echo " " & Mid(sObjectname, 3)
oApplication.DoCmd.DeleteObject dctDelete(sObjectname), Mid(sObjectname, 3)
Next
oApplication.CloseCurrentDatabase
oApplication.CompactRepair sStubADPFilename, sStubADPFilename & "_"
oApplication.Quit
fso.CopyFile sStubADPFilename & "_", sStubADPFilename
fso.DeleteFile sStubADPFilename & "_"
End Function
Public Function getErr()
Dim strError
strError = vbCrLf & "----------------------------------------------------------------------------------------------------------------------------------------" & vbCrLf & _
"From " & Err.source & ":" & vbCrLf & _
" Description: " & Err.Description & vbCrLf & _
" Code: " & Err.Number & vbCrLf
getErr = strError
End Function
compose.vbs:
' Usage:
' WScript compose.vbs <file> <path>
' Converts all modules, classes, forms and macros in a directory created by "decompose.vbs"
' and composes then into an Access Project file (.adp). This overwrites any existing Modules with the
' same names without warning!!!
' Requires Microsoft Access.
Option Explicit
const acForm = 2
const acModule = 5
const acMacro = 4
const acReport = 3
const acQuery = 1
Const acCmdCompileAndSaveAllModules = &H7E
' BEGIN CODE
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
dim sADPFilename
If (WScript.Arguments.Count = 0) then
MsgBox "Bitte den Dateinamen angeben!", vbExclamation, "Error"
Wscript.Quit()
End if
sADPFilename = fso.GetAbsolutePathName(WScript.Arguments(0))
Dim sPath
If (WScript.Arguments.Count = 1) then
sPath = ""
else
sPath = WScript.Arguments(1)
End If
importModulesTxt sADPFilename, sPath
If (Err <> 0) and (Err.Description <> NULL) Then
MsgBox Err.Description, vbExclamation, "Error"
Err.Clear
End If
Function importModulesTxt(sADPFilename, sImportpath)
Dim myComponent
Dim sModuleType
Dim sTempname
Dim sOutstring
' Build file and pathnames
dim myType, myName, myPath, sStubADPFilename
myType = fso.GetExtensionName(sADPFilename)
myName = fso.GetBaseName(sADPFilename)
myPath = fso.GetParentFolderName(sADPFilename)
' if no path was given as argument, use a relative directory
If (sImportpath = "") then
sImportpath = myPath & "\Source\"
End If
sStubADPFilename = sImportpath & myName & "_stub." & myType
' check for existing file and ask to overwrite with the stub
if (fso.FileExists(sADPFilename)) Then
WScript.StdOut.Write sADPFilename & " existiert bereits. Überschreiben? (j/n) "
dim sInput
sInput = WScript.StdIn.Read(1)
if (sInput <> "j") Then
WScript.Quit
end if
fso.CopyFile sADPFilename, sADPFilename & ".bak"
end if
fso.CopyFile sStubADPFilename, sADPFilename
' launch MSAccess
WScript.Echo "starting Access..."
Dim oApplication
Set oApplication = CreateObject("Access.Application")
WScript.Echo "opening " & sADPFilename & " ..."
If (Right(sStubADPFilename,4) = ".adp") Then
oApplication.OpenAccessProject sADPFilename
Else
oApplication.OpenCurrentDatabase sADPFilename
End If
oApplication.Visible = false
Dim folder
Set folder = fso.GetFolder(sImportpath)
' load each file from the import path into the stub
Dim myFile, objectname, objecttype
for each myFile in folder.Files
objecttype = fso.GetExtensionName(myFile.Name)
objectname = fso.GetBaseName(myFile.Name)
WScript.Echo " " & objectname & " (" & objecttype & ")"
if (objecttype = "form") then
oApplication.LoadFromText acForm, objectname, myFile.Path
elseif (objecttype = "bas") then
oApplication.LoadFromText acModule, objectname, myFile.Path
elseif (objecttype = "mac") then
oApplication.LoadFromText acMacro, objectname, myFile.Path
elseif (objecttype = "report") then
oApplication.LoadFromText acReport, objectname, myFile.Path
elseif (objecttype = "query") then
oApplication.LoadFromText acQuery, objectname, myFile.Path
end if
next
oApplication.RunCommand acCmdCompileAndSaveAllModules
oApplication.Quit
End Function
Public Function getErr()
Dim strError
strError = vbCrLf & "----------------------------------------------------------------------------------------------------------------------------------------" & vbCrLf & _
"From " & Err.source & ":" & vbCrLf & _
" Description: " & Err.Description & vbCrLf & _
" Code: " & Err.Number & vbCrLf
getErr = strError
End Function
Cette entrée décrit une approche totalement différente des autres entrées et n’est peut-être pas ce que vous recherchez. Donc, je ne serai pas offensé si vous ignorez cela. Mais au moins c'est matière à réflexion.
Dans certains environnements professionnels de développement de logiciels, la gestion de la configuration des logiciels livrables n’est généralement pas effectuée dans l’application logicielle elle-même ou le projet logiciel lui-même. CM impose aux produits livrables finaux en enregistrant le logiciel dans un dossier CM spécial, où le fichier et son dossier sont marqués avec l'identification de la version . Par exemple, Clearcase permet au gestionnaire de données d '"archiver" un logiciel. fichier, attribuez-lui une "branche", attribuez-lui une "bulle" et appliquez les "étiquettes" . Lorsque vous souhaitez voir et télécharger un fichier, vous devez configurer votre "spécification de configuration" pour qu'elle pointe vers la version que vous souhaitez. veux, puis cd dans le dossier et le voilà.
Juste une idée.
J'ai essayé de contribuer à sa réponse en ajoutant une option d'exportation pour les requêtes dans la base de données Access. (Avec l'aide de autre SO réponses )
Dim def
Set stream = fso.CreateTextFile(sExportpath & "\" & myName & ".queries.txt")
For Each def In oApplication.CurrentDb.QueryDefs
WScript.Echo " Exporting Queries to Text..."
stream.WriteLine("Name: " & def.Name)
stream.WriteLine(def.SQL)
stream.writeline "--------------------------"
stream.writeline " "
Next
stream.Close
Je ne peux pas intégrer cela dans la fonctionnalité 'Composer', mais ce n'est pas ce que j'ai besoin de faire pour le moment.
Remarque: j'ai également ajouté ".txt" à chacun des noms de fichier exportés dans decompose.vbs afin que le contrôle de source me montre immédiatement les différences de fichier.
J'espère que cela pourra aider!
Pour quiconque est bloqué avec Access 97, je n'ai pas pu obtenir les autres réponses au travail. En combinant les excellentes réponses de Oliver et de DaveParillo et en apportant quelques modifications, j'ai pu obtenir des scripts compatibles avec nos bases de données Access 97. C'est aussi un peu plus convivial puisqu'il demande quel dossier placer.
AccessExport.vbs:
' Converts all modules, classes, forms and macros from an Access file (.mdb) <input file> to
' text and saves the results in separate files to <path>. Requires Microsoft Access.
Option Explicit
Const acQuery = 1
Const acForm = 2
Const acModule = 5
Const acMacro = 4
Const acReport = 3
Const acCmdCompactDatabase = 4
Const TemporaryFolder = 2
Dim strMDBFileName : strMDBFileName = SelectDatabaseFile
Dim strExportPath : strExportPath = SelectExportFolder
CreateExportFolders(strExportPath)
Dim objProgressWindow
Dim strOverallProgress
CreateProgressWindow objProgressWindow
Dim strTempMDBFileName
CopyToTempDatabase strMDBFileName, strTempMDBFileName, strOverallProgress
Dim objAccess
Dim objDatabase
OpenAccessDatabase objAccess, objDatabase, strTempMDBFileName, strOverallProgress
ExportQueries objAccess, objDatabase, objProgressWindow, strExportPath, strOverallProgress
ExportForms objAccess, objDatabase, objProgressWindow, strExportPath, strOverallProgress
ExportReports objAccess, objDatabase, objProgressWindow, strExportPath, strOverallProgress
ExportMacros objAccess, objDatabase, objProgressWindow, strExportPath, strOverallProgress
ExportModules objAccess, objDatabase, objProgressWindow, strExportPath, strOverallProgress
objAccess.CloseCurrentDatabase
objAccess.Quit
DeleteTempDatabase strTempMDBFileName, strOverallProgress
objProgressWindow.Quit
MsgBox "Successfully exported database."
Private Function SelectDatabaseFile()
MsgBox "Please select the Access database to export."
Dim objFileOpen : Set objFileOpen = CreateObject("SAFRCFileDlg.FileOpen")
If objFileOpen.OpenFileOpenDlg Then
SelectDatabaseFile = objFileOpen.FileName
Else
WScript.Quit()
End If
End Function
Private Function SelectExportFolder()
Dim objShell : Set objShell = CreateObject("Shell.Application")
SelectExportFolder = objShell.BrowseForFolder(0, "Select folder to export the database to:", 0, "").self.path & "\"
End Function
Private Sub CreateExportFolders(strExportPath)
Dim objFileSystem : Set objFileSystem = CreateObject("Scripting.FileSystemObject")
MsgBox "Existing folders from a previous Access export under " & strExportPath & " will be deleted!"
If objFileSystem.FolderExists(strExportPath & "Queries\") Then
objFileSystem.DeleteFolder strExportPath & "Queries", true
End If
objFileSystem.CreateFolder(strExportPath & "Queries\")
If objFileSystem.FolderExists(strExportPath & "Forms\") Then
objFileSystem.DeleteFolder strExportPath & "Forms", true
End If
objFileSystem.CreateFolder(strExportPath & "Forms\")
If objFileSystem.FolderExists(strExportPath & "Reports\") Then
objFileSystem.DeleteFolder strExportPath & "Reports", true
End If
objFileSystem.CreateFolder(strExportPath & "Reports\")
If objFileSystem.FolderExists(strExportPath & "Macros\") Then
objFileSystem.DeleteFolder strExportPath & "Macros", true
End If
objFileSystem.CreateFolder(strExportPath & "Macros\")
If objFileSystem.FolderExists(strExportPath & "Modules\") Then
objFileSystem.DeleteFolder strExportPath & "Modules", true
End If
objFileSystem.CreateFolder(strExportPath & "Modules\")
End Sub
Private Sub CreateProgressWindow(objProgressWindow)
Set objProgressWindow = CreateObject ("InternetExplorer.Application")
objProgressWindow.Navigate "about:blank"
objProgressWindow.ToolBar = 0
objProgressWindow.StatusBar = 0
objProgressWindow.Width = 320
objProgressWindow.Height = 240
objProgressWindow.Visible = 1
objProgressWindow.Document.Title = "Access export in progress"
End Sub
Private Sub CopyToTempDatabase(strMDBFileName, strTempMDBFileName, strOverallProgress)
strOverallProgress = strOverallProgress & "Copying to temporary database...<br/>"
Dim objFileSystem : Set objFileSystem = CreateObject("Scripting.FileSystemObject")
strTempMDBFileName = objFileSystem.GetSpecialFolder(TemporaryFolder) & "\" & objFileSystem.GetBaseName(strMDBFileName) & "_temp.mdb"
objFileSystem.CopyFile strMDBFileName, strTempMDBFileName
End Sub
Private Sub OpenAccessDatabase(objAccess, objDatabase, strTempMDBFileName, strOverallProgress)
strOverallProgress = strOverallProgress & "Compacting temporary database...<br/>"
Set objAccess = CreateObject("Access.Application")
objAccess.Visible = false
CompactAccessDatabase objAccess, strTempMDBFileName
strOverallProgress = strOverallProgress & "Opening temporary database...<br/>"
objAccess.OpenCurrentDatabase strTempMDBFileName
Set objDatabase = objAccess.CurrentDb
End Sub
' Sometimes the Compact Database command errors out, and it's not serious if the database isn't compacted first.
Private Sub CompactAccessDatabase(objAccess, strTempMDBFileName)
On Error Resume Next
Dim objFileSystem : Set objFileSystem = CreateObject("Scripting.FileSystemObject")
objAccess.DbEngine.CompactDatabase strTempMDBFileName, strTempMDBFileName & "_"
objFileSystem.CopyFile strTempMDBFileName & "_", strTempMDBFileName
objFileSystem.DeleteFile strTempMDBFileName & "_"
End Sub
Private Sub ExportQueries(objAccess, objDatabase, objProgressWindow, strExportPath, strOverallProgress)
strOverallProgress = strOverallProgress & "Exporting Queries (Step 1 of 5)...<br/>"
Dim counter
For counter = 0 To objDatabase.QueryDefs.Count - 1
objProgressWindow.Document.Body.InnerHTML = strOverallProgress & counter + 1 & " of " & objDatabase.QueryDefs.Count
objAccess.SaveAsText acQuery, objDatabase.QueryDefs(counter).Name, strExportPath & "Queries\" & Clean(objDatabase.QueryDefs(counter).Name) & ".sql"
Next
End Sub
Private Sub ExportForms(objAccess, objDatabase, objProgressWindow, strExportPath, strOverallProgress)
strOverallProgress = strOverallProgress & "Exporting Forms (Step 2 of 5)...<br/>"
Dim counter : counter = 1
Dim objContainer : Set objContainer = objDatabase.Containers("Forms")
Dim objDocument
For Each objDocument In objContainer.Documents
objProgressWindow.Document.Body.InnerHTML = strOverallProgress & counter & " of " & objContainer.Documents.Count
counter = counter + 1
objAccess.SaveAsText acForm, objDocument.Name, strExportPath & "Forms\" & Clean(objDocument.Name) & ".form"
objAccess.DoCmd.Close acForm, objDocument.Name
Next
End Sub
Private Sub ExportReports(objAccess, objDatabase, objProgressWindow, strExportPath, strOverallProgress)
strOverallProgress = strOverallProgress & "Exporting Reports (Step 3 of 5)...<br/>"
Dim counter : counter = 1
Dim objContainer : Set objContainer = objDatabase.Containers("Reports")
Dim objDocument
For Each objDocument In objContainer.Documents
objProgressWindow.Document.Body.InnerHTML = strOverallProgress & counter & " of " & objContainer.Documents.Count
counter = counter + 1
objAccess.SaveAsText acReport, objDocument.Name, strExportPath & "Reports\" & Clean(objDocument.Name) & ".report"
Next
End Sub
Private Sub ExportMacros(objAccess, objDatabase, objProgressWindow, strExportPath, strOverallProgress)
strOverallProgress = strOverallProgress & "Exporting Macros (Step 4 of 5)...<br/>"
Dim counter : counter = 1
Dim objContainer : Set objContainer = objDatabase.Containers("Scripts")
Dim objDocument
For Each objDocument In objContainer.Documents
objProgressWindow.Document.Body.InnerHTML = strOverallProgress & counter & " of " & objContainer.Documents.Count
counter = counter + 1
objAccess.SaveAsText acMacro, objDocument.Name, strExportPath & "Macros\" & Clean(objDocument.Name) & ".macro"
Next
End Sub
Private Sub ExportModules(objAccess, objDatabase, objProgressWindow, strExportPath, strOverallProgress)
strOverallProgress = strOverallProgress & "Exporting Modules (Step 5 of 5)...<br/>"
Dim counter : counter = 1
Dim objContainer : Set objContainer = objDatabase.Containers("Modules")
Dim objDocument
For Each objDocument In objContainer.Documents
objProgressWindow.Document.Body.InnerHTML = strOverallProgress & counter & " of " & objContainer.Documents.Count
counter = counter + 1
objAccess.SaveAsText acModule, objDocument.Name, strExportPath & "Modules\" & Clean(objDocument.Name) & ".module"
Next
End Sub
Private Sub DeleteTempDatabase(strTempMDBFileName, strOverallProgress)
On Error Resume Next
strOverallProgress = strOverallProgress & "Deleting temporary database...<br/>"
Dim objFileSystem : Set objFileSystem = CreateObject("Scripting.FileSystemObject")
objFileSystem.DeleteFile strTempMDBFileName, true
End Sub
' Windows doesn't like certain characters, so we have to filter those out of the name when exporting
Private Function Clean(strInput)
Dim objRegexp : Set objRegexp = New RegExp
objRegexp.IgnoreCase = True
objRegexp.Global = True
objRegexp.Pattern = "[\\/:*?""<>|]"
Dim strOutput
If objRegexp.Test(strInput) Then
strOutput = objRegexp.Replace(strInput, "")
MsgBox strInput & " is being exported as " & strOutput
Else
strOutput = strInput
End If
Clean = strOutput
End Function
Et pour importer des fichiers dans la base de données, si vous devez recréer la base de données à partir de zéro ou si vous souhaitez modifier des fichiers en dehors d'Access pour une raison quelconque.
AccessImport.vbs:
' Imports all of the queries, forms, reports, macros, and modules from text
' files to an Access file (.mdb). Requires Microsoft Access.
Option Explicit
const acQuery = 1
const acForm = 2
const acModule = 5
const acMacro = 4
const acReport = 3
const acCmdCompileAndSaveAllModules = &H7E
Dim strMDBFilename : strMDBFilename = SelectDatabaseFile
CreateBackup strMDBFilename
Dim strImportPath : strImportPath = SelectImportFolder
Dim objAccess
Dim objDatabase
OpenAccessDatabase objAccess, objDatabase, strMDBFilename
Dim objProgressWindow
Dim strOverallProgress
CreateProgressWindow objProgressWindow
ImportQueries objAccess, objDatabase, objProgressWindow, strImportPath, strOverallProgress
ImportForms objAccess, objDatabase, objProgressWindow, strImportPath, strOverallProgress
ImportReports objAccess, objDatabase, objProgressWindow, strImportPath, strOverallProgress
ImportMacros objAccess, objDatabase, objProgressWindow, strImportPath, strOverallProgress
ImportModules objAccess, objDatabase, objProgressWindow, strImportPath, strOverallProgress
objAccess.CloseCurrentDatabase
objAccess.Quit
objProgressWindow.Quit
MsgBox "Successfully imported objects into the database."
Private Function SelectDatabaseFile()
MsgBox "Please select the Access database to import the objects from. ALL EXISTING OBJECTS WITH THE SAME NAME WILL BE OVERWRITTEN!"
Dim objFileOpen : Set objFileOpen = CreateObject( "SAFRCFileDlg.FileOpen" )
If objFileOpen.OpenFileOpenDlg Then
SelectDatabaseFile = objFileOpen.FileName
Else
WScript.Quit()
End If
End Function
Private Function SelectImportFolder()
Dim objShell : Set objShell = WScript.CreateObject("Shell.Application")
SelectImportFolder = objShell.BrowseForFolder(0, "Select folder to import the database objects from:", 0, "").self.path & "\"
End Function
Private Sub CreateBackup(strMDBFilename)
Dim objFileSystem : Set objFileSystem = CreateObject("Scripting.FileSystemObject")
objFileSystem.CopyFile strMDBFilename, strMDBFilename & ".bak"
End Sub
Private Sub OpenAccessDatabase(objAccess, objDatabase, strMDBFileName)
Set objAccess = CreateObject("Access.Application")
objAccess.OpenCurrentDatabase strMDBFilename
objAccess.Visible = false
Set objDatabase = objAccess.CurrentDb
End Sub
Private Sub CreateProgressWindow(ByRef objProgressWindow)
Set objProgressWindow = CreateObject ("InternetExplorer.Application")
objProgressWindow.Navigate "about:blank"
objProgressWindow.ToolBar = 0
objProgressWindow.StatusBar = 0
objProgressWindow.Width = 320
objProgressWindow.Height = 240
objProgressWindow.Visible = 1
objProgressWindow.Document.Title = "Access import in progress"
End Sub
Private Sub ImportQueries(objAccess, objDatabase, objProgressWindow, strImportPath, strOverallProgress)
strOverallProgress = "Importing Queries (Step 1 of 5)...<br/>"
Dim counter : counter = 0
Dim folder : Set folder = objFileSystem.GetFolder(strImportPath & "Queries\")
Dim objFileSystem : Set objFileSystem = CreateObject("Scripting.FileSystemObject")
Dim file
Dim strQueryName
For Each file in folder.Files
objProgressWindow.Document.Body.InnerHTML = strOverallProgress & counter + 1 & " of " & folder.Files.Count
strQueryName = objFileSystem.GetBaseName(file.Name)
objAccess.LoadFromText acQuery, strQueryName, file.Path
counter = counter + 1
Next
End Sub
Private Sub ImportForms(objAccess, objDatabase, objProgressWindow, strImportPath, strOverallProgress)
strOverallProgress = strOverallProgress & "Importing Forms (Step 2 of 5)...<br/>"
Dim counter : counter = 0
Dim folder : Set folder = objFileSystem.GetFolder(strImportPath & "Forms\")
Dim objFileSystem : Set objFileSystem = CreateObject("Scripting.FileSystemObject")
Dim file
Dim strFormName
For Each file in folder.Files
objProgressWindow.Document.Body.InnerHTML = strOverallProgress & counter + 1 & " of " & folder.Files.Count
strFormName = objFileSystem.GetBaseName(file.Name)
objAccess.LoadFromText acForm, strFormName, file.Path
counter = counter + 1
Next
End Sub
Private Sub ImportReports(objAccess, objDatabase, objProgressWindow, strImportPath, strOverallProgress)
strOverallProgress = strOverallProgress & "Importing Reports (Step 3 of 5)...<br/>"
Dim counter : counter = 0
Dim folder : Set folder = objFileSystem.GetFolder(strImportPath & "Reports\")
Dim objFileSystem : Set objFileSystem = CreateObject("Scripting.FileSystemObject")
Dim file
Dim strReportName
For Each file in folder.Files
objProgressWindow.Document.Body.InnerHTML = strOverallProgress & counter + 1 & " of " & folder.Files.Count
strReportName = objFileSystem.GetBaseName(file.Name)
objAccess.LoadFromText acReport, strReportName, file.Path
counter = counter + 1
Next
End Sub
Private Sub ImportMacros(objAccess, objDatabase, objProgressWindow, strImportPath, strOverallProgress)
strOverallProgress = strOverallProgress & "Importing Macros (Step 4 of 5)...<br/>"
Dim counter : counter = 0
Dim folder : Set folder = objFileSystem.GetFolder(strImportPath & "Macros\")
Dim objFileSystem : Set objFileSystem = CreateObject("Scripting.FileSystemObject")
Dim file
Dim strMacroName
For Each file in folder.Files
objProgressWindow.Document.Body.InnerHTML = strOverallProgress & counter + 1 & " of " & folder.Files.Count
strMacroName = objFileSystem.GetBaseName(file.Name)
objAccess.LoadFromText acMacro, strMacroName, file.Path
counter = counter + 1
Next
End Sub
Private Sub ImportModules(objAccess, objDatabase, objProgressWindow, strImportPath, strOverallProgress)
strOverallProgress = strOverallProgress & "Importing Modules (Step 5 of 5)...<br/>"
Dim counter : counter = 0
Dim folder : Set folder = objFileSystem.GetFolder(strImportPath & "Modules\")
Dim objFileSystem : Set objFileSystem = CreateObject("Scripting.FileSystemObject")
Dim file
Dim strModuleName
For Each file in folder.Files
objProgressWindow.Document.Body.InnerHTML = strOverallProgress & counter + 1 & " of " & folder.Files.Count
strModuleName = objFileSystem.GetBaseName(file.Name)
objAccess.LoadFromText acModule, strModuleName, file.Path
counter = counter + 1
Next
' We need to compile the database whenever any module code changes.
If Not objAccess.IsCompiled Then
objAccess.RunCommand acCmdCompileAndSaveAllModules
End If
End Sub