How do you use version control with Access development? - 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
Version control for MS Access? [duplicate]
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.
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