How do you use version control with Access develop

2018-12-31 16:32发布

站内文章 / 后端开发
18 0 0

问题:

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.

回答1:

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!



回答2:

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.



回答3:

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


回答4:

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.



回答5:

We developped our own internal tool, where:

  1. Modules: are exported as txt files and then compared with \"file compare tool\" (freeware)
  2. 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).
  3. Macros: we do not have any macro to compare, as we only have the \"autoexec\" macro with one line launching the main VBA procedure
  4. Queries: are just text strings stored in a table: see infra
  5. 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.



回答6:

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



回答7:

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!



回答8:

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.



回答9:

this script didn\'t work for us.

this did: http://www.accessmvp.com/Arvin/DocDatabase.txt



回答10:

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.



回答11:

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.



回答12:

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

  1. I have tested this only with .accdb files, so with anything else there might be some bugs.
  2. Setting are not exported, I would recommend creating the Macro that will apply the setting at start of the database.
  3. Some unknown queries sometimes get exported that are preceded with \'~\'. I don\'t know if they are necessary.

One of my other resources while working on this script was this answer, which helped me to figure out how to export relationships.



回答13:

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.



回答14:

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.



回答15:

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.



回答16:

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.



回答17:

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



回答18:

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


回答19:

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!



回答20:

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.



回答21:

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
        strReportNa
标签： ms-access version-control
举报

收藏的人(0)

登录 后发表评论
0条评论
还没有人评论过~