Version control for MS Access? [duplicate] - ms-access

I'm involved with updating an Access solution. It has a good amount of VBA, a number of queries, a small amount of tables, and a few forms for data entry & report generation. It's an ideal candidate for Access.
I want to make changes to the table design, the VBA, the queries, and the forms. How can I track my changes with version control? (we use Subversion, but this goes for any flavor) I can stick the entire mdb in subversion, but that will be storing a binary file, and I won't be able to tell that I just changed one line of VBA code.
I thought about copying the VBA code to separate files, and saving those, but I could see those quickly getting out of sync with what's in the database.

We wrote our own script in VBScript, that uses the undocumented Application.SaveAsText() in Access to export all code, form, macro and report modules. Here it is, it should give you some pointers. (Beware: some of the messages are in german, but you can easily change that.)
EDIT:
To summarize various comments below:
Our Project assumes an .adp-file. In order to get this work with .mdb/.accdb, you have to change OpenAccessProject() to OpenCurrentDatabase(). (Updated to use OpenAccessProject() if it sees a .adp extension, else use 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
If you need a clickable Command, instead of using the command line, create a file named "decompose.cmd" with
cscript decompose.vbs youraccessapplication.adp
By default, all exported files go into a "Scripts" subfolder of your Access-application. The .adp/mdb file is also copied to this location (with a "stub" suffix) and stripped of all the exported modules, making it really small.
You MUST checkin this stub with the source-files, because most access settings and custom menu-bars cannot be exported any other way. Just be sure to commit changes to this file only, if you really changed some setting or menu.
Note: If you have any Autoexec-Makros defined in your Application, you may have to hold the Shift-key when you invoke the decompose to prevent it from executing and interfering with the export!
Of course, there is also the reverse script, to build the Application from the "Source"-Directory:
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
Again, this goes with a companion "compose.cmd" containing:
cscript compose.vbs youraccessapplication.adp
It asks you to confirm overwriting your current application and first creates a backup, if you do. It then collects all source-files in the Source-Directory and re-inserts them into the stub.
Have Fun!

It appears to be something quite available in Access:
This link from msdn explains how to install a source control add-in for Microsoft Access. This shipped as a free download as a part of the Access Developer Extensions for Access 2007 and as a separate free add-in for Access 2003.
I am glad you asked this question and I took the time to look it up, as I would like this ability too. The link above has more information on this and links to the add-ins.
Update:
I installed the add-in for Access 2003. It will only work with VSS, but it does allow me to put Access objects (forms, queries, tables, modules, ect) into the repository. When you go edit any item in the repo you are asked to check it out, but you don't have to. Next I am going to check how it handles being opened and changed on a systems without the add-in. I am not a fan of VSS, but I really do like the thought of storing access objects in a repo.
Update2:
Machines without the add-in are unable to make any changes to the database structure (add table fields, query parameters, etc.). At first I thought this might be a problem if someone needed to, as there was no apparent way to remove the Access database from source control if Access didn't have the add-in loaded.
Id discovered that running "compact and repair" database prompts you if you want to remove the database from source control. I opted yes and was able to edit the database without the add-in. The article in the link above also give instructions in setting up Access 2003 and 2007 to use Team System. If you can find a MSSCCI provider for SVN, there is a good chance you can get that to work.

The compose/decompose solution posted by Oliver is great, but it has some problems:
The files are encoded as UCS-2 (UTF-16) which can cause version control systems/tools to consider the files to be binary.
The files contain a lot of cruft that changes often - checksums, printer information and more. This is a serious problem if you want clean diffs or need to cooperate on the project.
I was planning to fix this myself, but discovered there is already a good solution available: timabell/msaccess-vcs-integration on GitHub. I have tested msaccess-vcs-integration and it does work great.
Updated 3rd of March 2015: The project was originally maintained/owned by bkidwell on Github, but it was transferred to timabell - link above to project is updated accordingly. There are some forks from the original project by bkidwell, for example by ArminBra and by matonb, which AFAICT shouldn't be used.
The downside to using msaccess-vcs-integration compared to Olivers's decompose solution:
It's significantly slower. I'm sure that the speed issue can be fixed, but I don't need to export my project to text that often ...
It doesn't create a stub Access project with the exported stuff removed. This can also be fixed (by adopting code from the decompose script), but again - not that important.
Anyway, my clear recommendation is msaccess-vcs-integration. It solved all the problems I had with using Git on the exported files.

Olivers answer rocks, but the CurrentProject reference was not working for me. I ended up ripping the guts out of the middle of his export and replacing it with this, based on a similar solution by Arvin Meyer. Has the advantage of exporting Queries if you are using an mdb instead of an 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

We developped our own internal tool, where:
Modules: are exported as txt files and then compared with "file compare tool" (freeware)
Forms: are exported through the undocument application.saveAsText command. It is then possible to see the differences between 2 different versions ("file compare tool" once again).
Macros: we do not have any macro to compare, as we only have the "autoexec" macro with one line launching the main VBA procedure
Queries: are just text strings stored in a table: see infra
tables: we wrote our own table comparer, listing differences in records AND table structure.
The whole system is smart enough to allow us to produce "runtime" versions of our Access application, automatically generated from txt files (modules, and forms being recreated with the undocument application.loadFromText command) and mdb files (tables).
It might sound strange but it works.

Based on the ideas of this post and similar entries in some blogs I have wrote an application that works with mdb and adp file formats. It import/export all database objects (including tables, references, relations and database properties) to plain text files.
With those files you can work with a any source version control. Next version will allow import back the plain text files to the database. There will be also a command line tool
You can download the application or the source code from: http://accesssvn.codeplex.com/
regards

Resurrecting an old thread but this is a good one. I've implemented the two scripts (compose.vbs / decompose.vbs) for my own project and ran into a problem with old .mdb files:
It stalls when it gets to a form that includes the code:
NoSaveCTIWhenDisabled =1
Access says it has a problem and that's the end of the story. I ran some tests and played around trying to get around this issue and found this thread with a work around at the end:
Can't create database
Basically (in case the thread goes dead), you take the .mdb and do a "Save as" to the new .accdb format. Then the source safe or compose/decompose stuff will work. I also had to play around for 10 minutes to get the right command line syntax for the (de)compose scripts to work right so here's that info as well:
To compose (say your stuff is located in C:\SControl (create a sub folder named Source to store the extracted files):
'(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\
That's it!
The versions of Access where I've experienced the problem above include Access 2000-2003 ".mdb" databases and fixed the problem by saving them into the 2007-2010 ".accdb" formats prior to running the compose/decompose scripts. After the conversion the scripts work just fine!

Text-file only solution (queries, tables and relationships included)
I have altered the Oliver's pair of scripts so that they export/import relationships, tables and queries in addition to modules, classes, forms and macros. Everything is saved into plaintext files, so there is no database file created to be stored with the text files in version control.
Export into text files (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
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
You can execute this script by calling cscript decompose.vbs <path to file to decompose> <folder to store text files>. In case you omit the second parameter, it will create 'Source' folder where the database is located. Please note that destination folder will be wiped if it already exists.
Include data in the exported tables
Replace line 93: oApplication.ExportXML acExportTable, myObj.Name, , sExportpath & "\" & myObj.Name & ".table.txt"
with line oApplication.ExportXML acExportTable, myObj.Name, sExportpath & "\" & myObj.Name & ".table.txt"
Import into Create database file (compose.vbs)
' 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
You can execute this script by calling cscript compose.vbs <path to file which should be created> <folder with text files>. In case you omit the second parameter, it will look into 'Source' folder where the database should be created.
Import data from text file
Replace line 14: const acStructureOnly = 0 with const acStructureOnly = 1. This will work only if you have included the data in exported table.
Things that are not covered
I have tested this only with .accdb files, so with anything else there might be some bugs.
Setting are not exported, I would recommend creating the Macro that will apply the setting at start of the database.
Some unknown queries sometimes get exported that are preceded with '~'. I don't know if they are necessary.
MSAccess object names can contain characters that are invalid for filenames - the script will fail when trying to write them. You may normalize all filenames, but then you cannot import them back.
One of my other resources while working on this script was this answer, which helped me to figure out how to export relationships.

There's a gotcha - VSS 6.0 can only accept MDB's using the add-in under a certain number of objects, which includes all local tables, queries, modules, and forms. Don't know the exact object limit.
To build our 10 year old prod floor app, which is huge, we are forced to combine 3 or 4 separate MDBs out of SS into one MDB , which complicates automated builds to the point we don't waste time doing it.
I think I'll try the script above to spew this MDb into SVN and simplify builds for everyone.

For those using Access 2010, SaveAsText is not a visible method in Intellisense but it appears to be a valid method, as Arvin Meyer's script mentioned earlier worked fine for me.
Interestingly, SaveAsAXL is new to 2010 and has the same signature as SaveAsText, though it appears it will only work with web databases, which require SharePoint Server 2010.

We had the same issue a while ago.
Our first try was a third-party tool which offers a proxy of the SourceSafe API for Subversion to be used with MS Access and VB 6. The Tool can be found here.
As we were not that satisfied with that tool we switched over to Visual SourceSafe and the VSS Acces Plugin.

I'm using Oasis-Svn
http://dev2dev.de/
I just can tell it has saved me at least once. My mdb was growing beyond 2 GB and that broke it. I could go back to an old version and import the Forms and just lost a day or so of work.

I found this tool on SourceForge: http://sourceforge.net/projects/avc/
I haven't used it, but it may be a start for you. There may be some other 3rd party tools that integrate with VSS or SVN that do what you need.
Personally I just keep a plain text file handy to keep a change log. When I commit the binary MDB, I use the entries in the change log as my commit comment.

For completeness...
There's always "Visual Studio [YEAR] Tools for the Microsoft Office System"
(http://msdn.microsoft.com/en-us/vs2005/aa718673.aspx) but that seems to require VSS. To me VSS (auto corrupting) is worse than my 347 save points on my uber backuped network share.

i'm using the Access 2003 Add-in: Source Code Control. It works fine. One Problem are invalid characters like a ":".
I'm checkin in and out. Internly the Add-In do the same as the code up there, but with more tool support. I can see if an object is checked out and refresh the objects.

You can also connect your MS Access to the Team Foundation Server. There is also a free Express variant for up to 5 developers. Works really well!
English guide
Team Foundation Server 2012 Express
Edit: fixed link

The answer from Oliver works great. Please find my extended version below that adds support for Access queries.
(please see answer from Oliver for more information/usage)
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

I tried to help contribute to his answer by adding an export option for Queries within the access database. (With ample help from other SO answers)
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
Haven't be able to work that back into the 'compose' feature, but that's not what I need it to do right now.
Note: I also added ".txt" to each of the exported file names in decompose.vbs so that the source control would immediately show me the file diffs.
Hope that helps!

This entry describes a totally different approach from the other entries, and may not be what you're looking for. So I won't be offended if you ignore this. But at least it is food for thought.
In some professional commercial software development environments, configuration management (CM) of software deliverables is not normally done within the software application itself or software project itself. CM is imposed upon the final deliverable products, by saving the software in a special CM folder, where both the file and its folder are marked with version identification.
For example, Clearcase allows the data manager to "check in" a software file, assign it a "branch", assign it a "bubble", and apply "labels".
When you want to see and download a file, you have to configure your "config spec" to point to the version you want, then cd into the folder and there it is.
Just an idea.

For anyone stuck with Access 97, I was not able to get the other answers to work. Using a combination of Oliver's and DaveParillo's excellent answers and making some modifications, I was able to get the scripts working with our Access 97 databases. It's also a bit more user-friendly since it asks which folder to place the files.
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
And for importing files into the database, should you need to recreate the database from scratch or you wish to modify files outside of Access for some reason.
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

I am using OASIS-SVN from https://dev2dev.de/
This is not for free but for a small price.
It exports code, qrys, frms etc. to a folder.
From there I am using Git.

Related

Linking tables in Access

I have an access database that links to 6 tables. These tables are updated weekly and kept in a folder with the date. I would like for my access program to ask the user to select the location of the tables with out specifically using the Linked Table Manager.
The following code will prompt a user for the full path and file name of the database to be linked to. I decided to do this rather than just prompt for a folder. I strongly suggest you look at the connect string for one of your linked tables and make sure no other parameters are specified other than something like ';DATABASE=C:\Foldera\YYMMDD\MyAccessDB.mdb"
Private Function ReLinkTables()
Dim dbs As DAO.Database
Dim tdf As DAO.TableDef
Dim tdf2 As DAO.TableDef
Dim strConn As String
Dim strNewPath As String
Dim strTableName As String
On Error GoTo ERROR_HANDLER
' Prompt user for new path...
strNewPath = GetFolder
' Exit if none
If strNewPath = "" Then
Exit Function
End If
Set dbs = CurrentDb
dbs.TableDefs.Refresh
' Find all the linked tables...
For Each tdf In dbs.TableDefs
'Debug.Print tdf.Name & vbTab & tdf.Connect
If Len(tdf.Connect) > 0 Then
strTableName = tdf.Name
Debug.Print "Linked Table: " & tdf.Name & vbTab & tdf.Connect
dbs.TableDefs.Delete strTableName ' Delete the linked table
strConn = ";DATABASE=" & strNewPath
Set tdf2 = CurrentDb.CreateTableDef(strTableName, dbAttachSavePWD, strTableName, strConn)
CurrentDb.TableDefs.Append tdf2
Else ' Not a linked table
'Debug.Print "Keep: " & tdf.Name & vbTab & tdf.Connect
End If
Next tdf
Set tdf = Nothing
Set tdf2 = Nothing
dbs.TableDefs.Refresh
dbs.Close
Set dbs = Nothing
MsgBox "Finished Relinking Tables"
Proc_Exit:
Exit Function
ERROR_HANDLER:
Debug.Print Err.Number & vbTab & Err.Description
Err.Source = "Module_Load_SQLSERVER_DATABASE: ReLinkTables at Line: " & Erl
If Err.Number = 9999 Then
Resume Next
End If
MsgBox Err.Number & vbCrLf & Err.Description
Resume Proc_Exit
Resume Next
End Function
Function GetFolder() As String
Dim fldr As FileDialog
Dim sItem As String
Set fldr = Application.FileDialog(msoFileDialogFilePicker)
With fldr
.Title = "Select a Folder"
.AllowMultiSelect = False
'.InitialFileName = "Z:\xxxxxxxx" ' You can change to valid start path
If .Show <> -1 Then GoTo NextCode
sItem = .SelectedItems(1)
End With
NextCode:
Debug.Print "User selected path: >" & sItem & "<"
If sItem = "" Then MsgBox "User did not select a path.", vbOKOnly, "No Path"
GetFolder = sItem
Set fldr = Nothing
End Function

Fix link on-the-fly as an Error handle for error 3044 or more

I have a massive set of linked databases that have the potential to move. Luckily they are all in ONE working directory of nested folders.
I have effectively created a module that has the path of this working folder defined.
As strWorkingFolder
Now the VBA of the main control center remains intact for multiple calls running and executing queries (append, delete, insert) etc. EXCEPT each of the databases that are still linked to the old folder.
I figured that whenever the error 3044 (Not sure of the exact verbiage "The path to this table does not exist), I could just relink to the correct path - because it is known: It would be strWorkingFolder (concatenated to whatever nested folder the database is in)
I thought I could get away with just linked tables, but apparently, I will need to re-link all kinds of files: csv, Excel, as well as ACCDB.
How can I get it to work?
This is currently what I have setup
Sub RemoveLinks()
Dim tdf As TableDef
For Each tdf In CurrentDb.TableDefs
If Left(tdf.Name, 4) <> "MSys" And (tdf.Attributes And dbAttachedTable) = dbAttachedTable Then
CurrentDb.TableDefs.Delete tdf.Name
End If
Next tdf
Set tdf = Nothing
End Sub
Sub LinkDatabase(StrDBPath As String)
Dim dbs As Database
Dim tdf As TableDef
Set dbs = OpenDatabase(StrDBPath)
For Each tdf In dbs.TableDefs
If Left(tdf.Name, 4) <> "MSys" Then
DoCmd.TransferDatabase acLink, "Microsoft Access", Trim(StrDBPath), acTable, tdf.Name, tdf.Name
SysCmd acSysCmdSetStatus, "Processing table [" & tdf.Name & "]..."
End If
Next tdf
SysCmd acSysCmdClearStatus
Set dbs = Nothing
Set tdf = Nothing
End Sub
Sub RefreshLinks(StrDBPath As String)
Dim tdf As TableDef
For Each tdf In CurrentDb.TableDefs
If (tdf.Attributes And dbAttachedTable) = dbAttachedTable Then
tdf.Connect = "; Database = " & StrDBPath
SysCmd acSysCmdSetStatus, "Processing table [" & tdf.Name & "]..."
tdf.RefreshLink
End If
Next tdf
Set tdf = Nothing
SysCmd acSysCmdClearStatus
End Sub
And finally, in the error_handler, I will trap 3044 and call
Public Sub Relink(strEnginePath)
Dim dbs As Database
Set dbs = CurrentDb
RemoveLinks
LinkDatabase (strEnginePath)
RefreshLinks (strEnginePath)
End Sub
Is there a better way to go about this?
I have altered your code so it will handle text and Excel in addition to Access tables. If you have other types attached, you need to modify the code.
NOTE: With this code, you should NOT delete the links because that will remove all of the attributes you need!
Also, if you have any parameters following the path/file names in the connect strings, you need to add code to retain that information. I hope you have some standards in place that would allow some logical actions to be taken.
Sub RefreshLinks(StrDBPath As String)
Dim iLen As Integer
Dim iStart As Integer
Dim iEnd As Integer
Dim iPos As Integer
Dim strOldConn As String
Dim strNewConn As String
Dim strFile As String
Dim tdf As TableDef
On Error GoTo Error_Trap
For Each tdf In CurrentDb.TableDefs
If (tdf.Attributes And dbAttachedTable) = dbAttachedTable Then
Debug.Print "Table Name: " & tdf.Name
strOldConn = tdf.Connect ' Save the connect string
iLen = Len(strOldConn)
iStart = InStr(1, strOldConn, "DATABASE=") ' Find start of path
iEnd = InStr(iStart + 1, strOldConn, ";") ' Is there more after path?
Debug.Print tdf.Name & ": " & tdf.Connect
If LCase(left(strOldConn, 4)) = "text" Then ' Text file attached
strNewConn = left(strOldConn, iStart + 8) & StrDBPath
ElseIf LCase(left(strOldConn, 5)) = "excel" Then ' Excel file attached
strFile = ""
For iPos = iLen To 1 Step -1 ' Get the file name from the path
If Mid(strOldConn, iPos, 1) = "\" Then Exit For
strFile = Mid(strOldConn, iPos, 1) & strFile
Next
If iPos = 0 Then
MsgBox "Did not find path delimiter '\'" & vbCrLf & vbCrLf & "for TDF '" & tdf.Name & "'", vbOKOnly + vbCritical, "Path Delimiter Unknown"
End If
strNewConn = left(strOldConn, iStart + 8) & StrDBPath & "\" & strFile
Else
' Assume it is Access table. If other types, add code to handle.
strFile = ""
For iPos = iLen To 1 Step -1 ' Get the file name from the path
If Mid(strOldConn, iPos, 1) = "\" Then Exit For
strFile = Mid(strOldConn, iPos, 1) & strFile
Next
If iPos = 0 Then
MsgBox "Did not find path delimiter '\' in connect string '" & strOldConn & "'", vbOKOnly + vbCritical, "Wrong delimiter?"
End If
strNewConn = left(strOldConn, iStart + 8) & StrDBPath & "\" & strFile
End If
Debug.Print " (new): " & strNewConn
tdf.Connect = strNewConn
SysCmd acSysCmdSetStatus, "Processing table [" & tdf.Name & "]..."
tdf.RefreshLink
Else
' Ignore this table since it is not linked.
End If
Next tdf
Set tdf = Nothing
SysCmd acSysCmdClearStatus
Exit Sub
Error_Trap:
MsgBox "Error: " & Err.Number & vbTab & Err.Description & vbCrLf & vbCrLf & _
"While processing table: " & tdf.Name & vbCrLf & _
"Old: " & strOldConn & vbCrLf & _
"New: " & strNewConn, vbOKOnly, "Relink Error"
Exit Sub
End Sub

Sending Emails from Access DB containing attachment with dynamic name

I do not know how to get this thing to work beyond this point.
My code below sends an email containing an attachment out of MS Access 2010.
The problem is if it requires a fixed file name, my file name changes as I am using the date at the end of each file. example: green_12_04_2012.csv. I also do not know how to make this not fail if the folder is empty or the directory changes. It would be great for it to just skip to the next sub rather than crashing.
My Code:
Dim strGetFilePath As String
Dim strGetFileName As String
strGetFilePath = "C:\datafiles\myfolder\*.csv"
strGetFileName = Dir(strGetFilePath)
Dim appOutLook As Outlook.Application
Dim MailOutLook As Outlook.MailItem
Set appOutLook = CreateObject("Outlook.Application")
Set MailOutLook = appOutLook.CreateItem(olMailItem)
With MailOutLook
.BodyFormat = olFormatRichText
.To = "bob#builder.com"
''.cc = ""
''.bcc = ""
.Subject = "text here"
.HTMLBody = "text here"
.Attachments.Add (strGetFileName & "*.csv")
.Send
End With
End Sub
I think I am getting there.
I found a suitable resolution and in addition to the solution posted, I wanted to add this in-case anyone is searching for the solution. I was up until 3am, this is a very popular question but there was not any resolution in regards to looping an attaching all files in a specific folder.
Here is the code:
Public Sub sendEmail()
Dim appOutLook As Outlook.Application
Dim MailOutLook As Outlook.MailItem
Dim strPath As String
Dim strFilter As String
Dim strFile As String
strPath = "C:\Users\User\Desktop\" 'Edit to your path
strFilter = "*.csv"
strFile = Dir(strPath & strFilter)
If strFile <> "" Then
Set appOutLook = CreateObject("Outlook.Application")
Set MailOutLook = appOutLook.CreateItem(olMailItem)
With MailOutLook
.BodyFormat = olFormatRichText
.To = "bob#builder.com"
''.cc = ""
''.bcc = ""
.Subject = "text here"
.HTMLBody = "text here"
.Attachments.Add (strPath & strFile)
.Send
'.Display 'Used during testing without sending (Comment out .Send if using this line)
End With
Else
MsgBox "No file matching " & strPath & strFilter & " found." & vbCrLf & _
"Processing terminated.
Exit Sub 'This line only required if more code past End If
End If
End Sub
heres code i found on one of the forums and cant remember where, but i modified it slightly
this gives you full path of the file, it searches folder and subfolders using wildcard
Function fSearchFileWild(FileName As String, Extenstion As String)
Dim strFileName As String
Dim strDirectory As String
strFileName = "*" & FileName & "*." & Extenstion
strDirectory = "C:\Documents and Settings\"
fSearchFileWild = ListFiles(strDirectory, strFileName, True)
End Function
Public Function ListFiles(strPath As String, Optional strFileSpec As String, _
Optional bIncludeSubfolders As Boolean, Optional lst As ListBox)
On Error GoTo Err_Handler
Dim colDirList As New Collection
Dim varItem As Variant
Call FillDir(colDirList, strPath, strFileSpec, bIncludeSubfolders)
Dim counter As Integer
counter = 0
Dim file1 As String
Dim file2 As String
Dim file3 As String
For Each varItem In colDirList
If file1 = "" Then
file1 = varItem
counter = 1
ElseIf file2 = "" Then
file2 = varItem
counter = 2
ElseIf file3 = "" Then
file3 = varItem
counter = 3
End If
Next
'if there is more than 1 file, msgbox displays first 3 files
If counter = 1 Then
ListFiles = file1
ElseIf counter > 1 Then
MsgBox "Search has found Multiple files for '" & strFileSpec & "', first 3 files are: " & vbNewLine _
& vbNewLine & "file1: " & file1 & vbNewLine _
& vbNewLine & "file2: " & file2 & vbNewLine _
& vbNewLine & "file3: " & file3
ListFiles = "null"
Else
ListFiles = "null"
End If
Exit_Handler:
Exit Function
Err_Handler:
MsgBox "Error " & Err.Number & ": " & Err.Description
Resume Exit_Handler
End Function
Private Function FillDir(colDirList As Collection, ByVal strFolder As String, strFileSpec As String, _
bIncludeSubfolders As Boolean)
'Build up a list of files, and then add add to this list, any additional folders
Dim strTemp As String
Dim colFolders As New Collection
Dim vFolderName As Variant
'Add the files to the folder.
strFolder = TrailingSlash(strFolder)
strTemp = Dir(strFolder & strFileSpec)
Do While strTemp <> vbNullString
colDirList.Add strFolder & strTemp
strTemp = Dir
Loop
If bIncludeSubfolders Then
'Build collection of additional subfolders.
strTemp = Dir(strFolder, vbDirectory)
Do While strTemp <> vbNullString
If (strTemp <> ".") And (strTemp <> "..") Then
If (GetAttr(strFolder & strTemp) And vbDirectory) <> 0& Then
colFolders.Add strTemp
End If
End If
strTemp = Dir
Loop
'Call function recursively for each subfolder.
For Each vFolderName In colFolders
Call FillDir(colDirList, strFolder & TrailingSlash(vFolderName), strFileSpec, True)
Next vFolderName
End If
End Function
Public Function TrailingSlash(varIn As Variant) As String
If Len(varIn) > 0& Then
If Right(varIn, 1&) = "\" Then
TrailingSlash = varIn
Else
TrailingSlash = varIn & "\"
End If
End If
End Function

exporting code from Microsoft Access

Is there any way to bulk-export Microsoft Access code to files? I see I can export one file at a time, but there are hundreds and I'll be here all day. It there no "Export All" or multi-select export anywhere?
You can do this without having to write any code at all. From the menu, choose tools->analyze->database documenter.
This will give you a bunch of options to print out the code. You can then while viewing the report ether send it out to your PDF printer (if you have one). Or, simply print out to a text file printer. Or you can even then click on the word option in the report menu bar and the results will be sent out to word
The database documenter has provisions to print out all code, including code in forms.
So, in place of some of the suggested code examples you can do this without having to write any code at all. Do play with the additional options in the documenter. The documenter will produce HUGE volumes print out information for every single property and object in the database. So, if you don't un-check some of the options then you will easily empty a full size printer tray of paper. This documenter thus results in huge printouts.
To output all code to desktop, including code from forms and reports, you can paste this into a standard module and run it by pressing F5 or step through with F8. You may wish to fill in the name of the desktop folder first.
Sub AllCodeToDesktop()
''The reference for the FileSystemObject Object is Windows Script Host Object Model
''but it not necessary to add the reference for this procedure.
Dim fs As Object
Dim f As Object
Dim strMod As String
Dim mdl As Object
Dim i As Integer
Set fs = CreateObject("Scripting.FileSystemObject")
''Set up the file.
''SpFolder is a small function, but it would be better to fill in a
''path name instead of SpFolder(Desktop), eg "c:\users\somename\desktop"
Set f = fs.CreateTextFile(SpFolder(Desktop) & "\" _
& Replace(CurrentProject.Name, ".", "") & ".txt")
''For each component in the project ...
For Each mdl In VBE.ActiveVBProject.VBComponents
''using the count of lines ...
i = VBE.ActiveVBProject.VBComponents(mdl.Name).CodeModule.CountOfLines
''put the code in a string ...
If i > 0 Then
strMod = VBE.ActiveVBProject.VBComponents(mdl.Name).codemodule.Lines(1, i)
End If
''and then write it to a file, first marking the start with
''some equal signs and the component name.
f.writeline String(15, "=") & vbCrLf & mdl.Name _
& vbCrLf & String(15, "=") & vbCrLf & strMod
Next
''Close eveything
f.Close
Set fs = Nothing
End Sub
To get special folders, you can use the list supplied by Microsoft.
Enumerating Special Folders: http://www.microsoft.com/technet/scriptcenter/guide/sas_fil_higv.mspx?mfr=true
From: http://wiki.lessthandot.com/index.php/Code_and_Code_Windows
There is nothing in the interface to export more than one module at a time.
You can code your own "export all" equivalent easily:
Public Sub ExportModules()
Const cstrExtension As String = ".bas"
Dim objModule As Object
Dim strFolder As String
Dim strDestination As String
strFolder = CurrentProject.Path
For Each objModule In CurrentProject.AllModules
strDestination = strFolder & Chr(92) & objModule.Name & cstrExtension
Application.SaveAsText acModule, objModule.Name, strDestination
Next objModule
End Sub
Here's my version:
'============================================================'
' OutputCodeModules for Access
' Don Jewett, verion 2014.11.10
' Exports the following items from an Access database
' Modules
' Form Modules
' Report Modules
'
' Must be imported into Access database and run from there
'============================================================'
Option Explicit
Option Compare Database
Private Const KEY_MODULES As String = "Modules"
Private Const KEY_FORMS As String = "Forms"
Private Const KEY_REPORTS As String = "Reports"
Private m_bCancel As Boolean
Private m_sLogPath As String
'------------------------------------------------------------'
' >>>>>> Run this using F5 or F8 <<<<<<<<
'------------------------------------------------------------'
Public Sub OutputModuleHelper()
OutputModules
End Sub
Public Sub OutputModules(Optional ByVal sFolder As String)
Dim nCount As Long
Dim nSuccessful As Long
Dim sLine As String
Dim sMessage As String
Dim sFile As String
If sFolder = "" Then
sFolder = Left$(CurrentDb.Name, InStrRev(CurrentDb.Name, "\") - 1)
sFolder = InputBox("Enter folder for files", "Output Code", sFolder)
If sFolder = "" Then
Exit Sub
End If
End If
'normalize root path by removing trailing back-slash
If Right(sFolder, 1) = "\" Then
sFolder = Left(sFolder, Len(sFolder) - 1)
End If
'make sure this folder exists
If Not isDir(sFolder) Then
MsgBox "Folder does not exist", vbExclamation Or vbOKOnly
Exit Sub
End If
'get a new log filename
m_sLogPath = sFolder & "\_log-" & Format(Date, "yyyy-MM-dd-nn-mm-ss") & ".txt"
sLine = CurrentDb.Name
writeLog sLine
sMessage = sLine & vbCrLf
sLine = Format(Now, "yyyy-MM-dd nn:mm:ss") & vbCrLf
writeLog sLine
sMessage = sMessage & sLine & vbCrLf
'output modules
nCount = CurrentDb.Containers(KEY_MODULES).Documents.Count
nSuccessful = outputContainerModules(sFolder, KEY_MODULES)
'write to the log file and final message
sLine = nSuccessful & vbTab & "of" & vbTab & nCount & vbTab & KEY_MODULES & " exported"
writeFile m_sLogPath, sLine, True
sMessage = sMessage & vbTab & sLine & vbCrLf
'output form modules
If Not m_bCancel Then
nCount = CurrentDb.Containers(KEY_FORMS).Documents.Count
nSuccessful = outputContainerModules(sFolder, KEY_FORMS)
'write to the log file and final message
sLine = nSuccessful & vbTab & "of" & vbTab & nCount & vbTab & "Form Modules exported"
writeFile m_sLogPath, sLine, True
sMessage = sMessage & vbTab & sLine & vbCrLf
End If
'output report modules
If Not m_bCancel Then
nCount = CurrentDb.Containers(KEY_REPORTS).Documents.Count
nSuccessful = outputContainerModules(sFolder, KEY_REPORTS)
'write to the log file and final message
sLine = nSuccessful & vbTab & "of" & vbTab & nCount & vbTab & "Report Modules exported"
writeFile m_sLogPath, sLine, True
sMessage = sMessage & vbTab & sLine & vbCrLf
End If
If Len(sMessage) Then
MsgBox sMessage, vbInformation Or vbOKOnly, "OutputModules"
End If
End Sub
Private Function outputContainerModules( _
ByVal sFolder As String, _
ByVal sKey As String) As Long
Dim n As Long
Dim nCount As Long
Dim sName As String
Dim sPath As String
On Error GoTo EH
'refactored this to use reference to Documents,
'but the object reference doesn't stick around
'and I had to roll back to this which isn't as pretty.
'but this works (and if it ain't broke...)
For n = 0 To CurrentDb.Containers(sKey).Documents.Count - 1
nCount = nCount + 1
sName = CurrentDb.Containers(sKey).Documents(n).Name
Select Case sKey
Case KEY_FORMS
sName = "Form_" & sName
Case KEY_REPORTS
sName = "Report_" & sName
End Select
sPath = sFolder & "\" & sName & ".txt"
DoCmd.OutputTo acOutputModule, sName, acFormatTXT, sPath, False
Next 'n
outputContainerModules = nCount
Exit Function
EH:
nCount = nCount - 1
Select Case Err.Number
Case 2289 'can't output the module in the requested format.
'TODO: research - I think this happens when a Form/Report doesn't have a module
Resume Next
Case Else
Dim sMessage As String
writeError Err, sKey, sName, nCount
sMessage = "An Error ocurred outputting " & sKey & ": " & sName & vbCrLf & vbCrLf _
& "Number " & Err.Number & vbCrLf _
& "Description:" & Err.Description & vbCrLf & vbCrLf _
& "Click [Yes] to continue with export or [No] to stop."
If vbYes = MsgBox(sMessage, vbQuestion Or vbYesNo Or vbDefaultButton2, "Error") Then
Resume Next
Else
m_bCancel = True
outputContainerModules = nCount
End If
End Select
End Function
Private Function writeFile( _
ByVal sPath As String, _
ByRef sMessage As String, _
Optional ByVal bAppend As Boolean) As Boolean
'Dim oFSO as Object
'Dim oStream as Object
'Const ForWriting As Long = 2
'Const ForAppending As Long = 8
'Dim eFlags As Long
Dim oFSO As FileSystemObject
Dim oStream As TextStream
Dim eFlags As IOMode
On Error GoTo EH
'Set oFSO = Server.CreateObject("Scripting.FileSystemObject")
Set oFSO = New FileSystemObject
If bAppend Then
eFlags = ForAppending
Else
eFlags = ForWriting
End If
Set oStream = oFSO.OpenTextFile(sPath, eFlags, True)
oStream.WriteLine sMessage
writeFile = True
GoTo CLEAN
EH:
writeFile = False
CLEAN:
If Not oFSO Is Nothing Then
Set oFSO = Nothing
End If
If Not oStream Is Nothing Then
Set oStream = Nothing
End If
End Function
Private Sub writeError( _
ByRef oErr As ErrObject, _
ByVal sType As String, _
ByVal sName As String, _
ByVal nCount As Long)
Dim sMessage As String
sMessage = "An Error ocurred outputting " & sType & ": " & sName & " (" & nCount & ")" & vbCrLf _
& "Number " & oErr.Number & vbCrLf _
& "Description:" & oErr.Description & vbCrLf & vbCrLf
writeLog sMessage
End Sub
Private Sub writeLog( _
ByRef sMessage As String)
On Error GoTo EH
writeFile m_sLogPath, sMessage & vbCrLf, True
Exit Sub
EH:
'swallow errors?
End Sub
Private Function isDir(ByVal sPath As String) As Boolean
On Error GoTo EH
If Right$(sPath, 1) <> "\" Then
sPath = sPath & "\"
End If
If Dir$(sPath & ".", vbDirectory) = "." Then
isDir = True
ElseIf Len(sPath) = 3 Then
If Dir$(sPath, vbVolume) = Left(sPath, 1) Then
isDir = True
End If
End If
Exit Function
EH:
isDir = False
End Function

How do you use version control with Access development?

I'm involved with updating an Access solution. It has a good amount of VBA, a number of queries, a small amount of tables, and a few forms for data entry & report generation. It's an ideal candidate for Access.
I want to make changes to the table design, the VBA, the queries, and the forms. How can I track my changes with version control? (we use Subversion, but this goes for any flavor) I can stick the entire mdb in subversion, but that will be storing a binary file, and I won't be able to tell that I just changed one line of VBA code.
I thought about copying the VBA code to separate files, and saving those, but I could see those quickly getting out of sync with what's in the database.
We wrote our own script in VBScript, that uses the undocumented Application.SaveAsText() in Access to export all code, form, macro and report modules. Here it is, it should give you some pointers. (Beware: some of the messages are in german, but you can easily change that.)
EDIT:
To summarize various comments below:
Our Project assumes an .adp-file. In order to get this work with .mdb/.accdb, you have to change OpenAccessProject() to OpenCurrentDatabase(). (Updated to use OpenAccessProject() if it sees a .adp extension, else use 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
If you need a clickable Command, instead of using the command line, create a file named "decompose.cmd" with
cscript decompose.vbs youraccessapplication.adp
By default, all exported files go into a "Scripts" subfolder of your Access-application. The .adp/mdb file is also copied to this location (with a "stub" suffix) and stripped of all the exported modules, making it really small.
You MUST checkin this stub with the source-files, because most access settings and custom menu-bars cannot be exported any other way. Just be sure to commit changes to this file only, if you really changed some setting or menu.
Note: If you have any Autoexec-Makros defined in your Application, you may have to hold the Shift-key when you invoke the decompose to prevent it from executing and interfering with the export!
Of course, there is also the reverse script, to build the Application from the "Source"-Directory:
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
Again, this goes with a companion "compose.cmd" containing:
cscript compose.vbs youraccessapplication.adp
It asks you to confirm overwriting your current application and first creates a backup, if you do. It then collects all source-files in the Source-Directory and re-inserts them into the stub.
Have Fun!
It appears to be something quite available in Access:
This link from msdn explains how to install a source control add-in for Microsoft Access. This shipped as a free download as a part of the Access Developer Extensions for Access 2007 and as a separate free add-in for Access 2003.
I am glad you asked this question and I took the time to look it up, as I would like this ability too. The link above has more information on this and links to the add-ins.
Update:
I installed the add-in for Access 2003. It will only work with VSS, but it does allow me to put Access objects (forms, queries, tables, modules, ect) into the repository. When you go edit any item in the repo you are asked to check it out, but you don't have to. Next I am going to check how it handles being opened and changed on a systems without the add-in. I am not a fan of VSS, but I really do like the thought of storing access objects in a repo.
Update2:
Machines without the add-in are unable to make any changes to the database structure (add table fields, query parameters, etc.). At first I thought this might be a problem if someone needed to, as there was no apparent way to remove the Access database from source control if Access didn't have the add-in loaded.
Id discovered that running "compact and repair" database prompts you if you want to remove the database from source control. I opted yes and was able to edit the database without the add-in. The article in the link above also give instructions in setting up Access 2003 and 2007 to use Team System. If you can find a MSSCCI provider for SVN, there is a good chance you can get that to work.
The compose/decompose solution posted by Oliver is great, but it has some problems:
The files are encoded as UCS-2 (UTF-16) which can cause version control systems/tools to consider the files to be binary.
The files contain a lot of cruft that changes often - checksums, printer information and more. This is a serious problem if you want clean diffs or need to cooperate on the project.
I was planning to fix this myself, but discovered there is already a good solution available: timabell/msaccess-vcs-integration on GitHub. I have tested msaccess-vcs-integration and it does work great.
Updated 3rd of March 2015: The project was originally maintained/owned by bkidwell on Github, but it was transferred to timabell - link above to project is updated accordingly. There are some forks from the original project by bkidwell, for example by ArminBra and by matonb, which AFAICT shouldn't be used.
The downside to using msaccess-vcs-integration compared to Olivers's decompose solution:
It's significantly slower. I'm sure that the speed issue can be fixed, but I don't need to export my project to text that often ...
It doesn't create a stub Access project with the exported stuff removed. This can also be fixed (by adopting code from the decompose script), but again - not that important.
Anyway, my clear recommendation is msaccess-vcs-integration. It solved all the problems I had with using Git on the exported files.
Olivers answer rocks, but the CurrentProject reference was not working for me. I ended up ripping the guts out of the middle of his export and replacing it with this, based on a similar solution by Arvin Meyer. Has the advantage of exporting Queries if you are using an mdb instead of an 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
We developped our own internal tool, where:
Modules: are exported as txt files and then compared with "file compare tool" (freeware)
Forms: are exported through the undocument application.saveAsText command. It is then possible to see the differences between 2 different versions ("file compare tool" once again).
Macros: we do not have any macro to compare, as we only have the "autoexec" macro with one line launching the main VBA procedure
Queries: are just text strings stored in a table: see infra
tables: we wrote our own table comparer, listing differences in records AND table structure.
The whole system is smart enough to allow us to produce "runtime" versions of our Access application, automatically generated from txt files (modules, and forms being recreated with the undocument application.loadFromText command) and mdb files (tables).
It might sound strange but it works.
Based on the ideas of this post and similar entries in some blogs I have wrote an application that works with mdb and adp file formats. It import/export all database objects (including tables, references, relations and database properties) to plain text files.
With those files you can work with a any source version control. Next version will allow import back the plain text files to the database. There will be also a command line tool
You can download the application or the source code from: http://accesssvn.codeplex.com/
regards
Resurrecting an old thread but this is a good one. I've implemented the two scripts (compose.vbs / decompose.vbs) for my own project and ran into a problem with old .mdb files:
It stalls when it gets to a form that includes the code:
NoSaveCTIWhenDisabled =1
Access says it has a problem and that's the end of the story. I ran some tests and played around trying to get around this issue and found this thread with a work around at the end:
Can't create database
Basically (in case the thread goes dead), you take the .mdb and do a "Save as" to the new .accdb format. Then the source safe or compose/decompose stuff will work. I also had to play around for 10 minutes to get the right command line syntax for the (de)compose scripts to work right so here's that info as well:
To compose (say your stuff is located in C:\SControl (create a sub folder named Source to store the extracted files):
'(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\
That's it!
The versions of Access where I've experienced the problem above include Access 2000-2003 ".mdb" databases and fixed the problem by saving them into the 2007-2010 ".accdb" formats prior to running the compose/decompose scripts. After the conversion the scripts work just fine!
Text-file only solution (queries, tables and relationships included)
I have altered the Oliver's pair of scripts so that they export/import relationships, tables and queries in addition to modules, classes, forms and macros. Everything is saved into plaintext files, so there is no database file created to be stored with the text files in version control.
Export into text files (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
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
You can execute this script by calling cscript decompose.vbs <path to file to decompose> <folder to store text files>. In case you omit the second parameter, it will create 'Source' folder where the database is located. Please note that destination folder will be wiped if it already exists.
Include data in the exported tables
Replace line 93: oApplication.ExportXML acExportTable, myObj.Name, , sExportpath & "\" & myObj.Name & ".table.txt"
with line oApplication.ExportXML acExportTable, myObj.Name, sExportpath & "\" & myObj.Name & ".table.txt"
Import into Create database file (compose.vbs)
' 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
You can execute this script by calling cscript compose.vbs <path to file which should be created> <folder with text files>. In case you omit the second parameter, it will look into 'Source' folder where the database should be created.
Import data from text file
Replace line 14: const acStructureOnly = 0 with const acStructureOnly = 1. This will work only if you have included the data in exported table.
Things that are not covered
I have tested this only with .accdb files, so with anything else there might be some bugs.
Setting are not exported, I would recommend creating the Macro that will apply the setting at start of the database.
Some unknown queries sometimes get exported that are preceded with '~'. I don't know if they are necessary.
MSAccess object names can contain characters that are invalid for filenames - the script will fail when trying to write them. You may normalize all filenames, but then you cannot import them back.
One of my other resources while working on this script was this answer, which helped me to figure out how to export relationships.
There's a gotcha - VSS 6.0 can only accept MDB's using the add-in under a certain number of objects, which includes all local tables, queries, modules, and forms. Don't know the exact object limit.
To build our 10 year old prod floor app, which is huge, we are forced to combine 3 or 4 separate MDBs out of SS into one MDB , which complicates automated builds to the point we don't waste time doing it.
I think I'll try the script above to spew this MDb into SVN and simplify builds for everyone.
For those using Access 2010, SaveAsText is not a visible method in Intellisense but it appears to be a valid method, as Arvin Meyer's script mentioned earlier worked fine for me.
Interestingly, SaveAsAXL is new to 2010 and has the same signature as SaveAsText, though it appears it will only work with web databases, which require SharePoint Server 2010.
We had the same issue a while ago.
Our first try was a third-party tool which offers a proxy of the SourceSafe API for Subversion to be used with MS Access and VB 6. The Tool can be found here.
As we were not that satisfied with that tool we switched over to Visual SourceSafe and the VSS Acces Plugin.
I'm using Oasis-Svn
http://dev2dev.de/
I just can tell it has saved me at least once. My mdb was growing beyond 2 GB and that broke it. I could go back to an old version and import the Forms and just lost a day or so of work.
I found this tool on SourceForge: http://sourceforge.net/projects/avc/
I haven't used it, but it may be a start for you. There may be some other 3rd party tools that integrate with VSS or SVN that do what you need.
Personally I just keep a plain text file handy to keep a change log. When I commit the binary MDB, I use the entries in the change log as my commit comment.
For completeness...
There's always "Visual Studio [YEAR] Tools for the Microsoft Office System"
(http://msdn.microsoft.com/en-us/vs2005/aa718673.aspx) but that seems to require VSS. To me VSS (auto corrupting) is worse than my 347 save points on my uber backuped network share.
i'm using the Access 2003 Add-in: Source Code Control. It works fine. One Problem are invalid characters like a ":".
I'm checkin in and out. Internly the Add-In do the same as the code up there, but with more tool support. I can see if an object is checked out and refresh the objects.
You can also connect your MS Access to the Team Foundation Server. There is also a free Express variant for up to 5 developers. Works really well!
English guide
Team Foundation Server 2012 Express
Edit: fixed link
The answer from Oliver works great. Please find my extended version below that adds support for Access queries.
(please see answer from Oliver for more information/usage)
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
I tried to help contribute to his answer by adding an export option for Queries within the access database. (With ample help from other SO answers)
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
Haven't be able to work that back into the 'compose' feature, but that's not what I need it to do right now.
Note: I also added ".txt" to each of the exported file names in decompose.vbs so that the source control would immediately show me the file diffs.
Hope that helps!
This entry describes a totally different approach from the other entries, and may not be what you're looking for. So I won't be offended if you ignore this. But at least it is food for thought.
In some professional commercial software development environments, configuration management (CM) of software deliverables is not normally done within the software application itself or software project itself. CM is imposed upon the final deliverable products, by saving the software in a special CM folder, where both the file and its folder are marked with version identification.
For example, Clearcase allows the data manager to "check in" a software file, assign it a "branch", assign it a "bubble", and apply "labels".
When you want to see and download a file, you have to configure your "config spec" to point to the version you want, then cd into the folder and there it is.
Just an idea.
For anyone stuck with Access 97, I was not able to get the other answers to work. Using a combination of Oliver's and DaveParillo's excellent answers and making some modifications, I was able to get the scripts working with our Access 97 databases. It's also a bit more user-friendly since it asks which folder to place the files.
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
And for importing files into the database, should you need to recreate the database from scratch or you wish to modify files outside of Access for some reason.
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
I am using OASIS-SVN from https://dev2dev.de/
This is not for free but for a small price.
It exports code, qrys, frms etc. to a folder.
From there I am using Git.