你如何使用Access开发版本控制？
我参与了更新Access解决scheme。 它有大量的VBA，大量的查询，less量的表格以及用于数据input和报告生成的一些表格。 这是Access的理想人选。
我想更改表devise，VBA，查询和表单。 如何使用版本控制跟踪我的更改？ （我们使用的是Subversion，但是这样做有一定的风格）我可以将整个mdb保存在subversion中，但是这将会存储一个二进制文件，我不能告诉我只是更改了一行VBA代码。
我想过复制VBA代码来分离文件，并保存这些文件，但是我可以看到这些文件很快就与数据库中的内容不同步。
我们在VBScript中编写了自己的脚本，它使用Access中未公开的Application.SaveAsText（）来导出所有代码，表单，macros和报告模块。 在这里，它应该给你一些指示。 （注意：有些信息是德文的，但是你可以很容易地改变它。）
编辑：总结下面的各种评论： 我们的项目假设一个.adp文件。 为了使用.mdb / .accdb进行这项工作，必须将OpenAccessProject（）更改为OpenCurrentDatabase（） 。 （如果看到.adp扩展名，则更新为使用OpenAccessProject() ，否则使用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
如果您需要可点击的命令，而不是使用命令行，请创build一个名为“decompose.cmd”的文件
cscript decompose.vbs youraccessapplication.adp
默认情况下，所有导出的文件进入Access应用程序的“脚本”子文件夹。 .adp / mdb文件也被复制到这个位置（带有“stub”后缀），并且被剥离了所有导出的模块，使得它非常小。
你必须检查这个存根与源文件，因为大多数访问设置和自定义菜单栏不能以任何其他方式导出。 只要确实要改变这个文件，如果你真的改变了一些设置或菜单。
注意：如果您在应用程序中定义了任何Autoexec-Makros，则在调用分解时可能不得不按住Shift键，以防止执行并干扰导出！
当然，也有反向脚本，从“Source”目录构build应用程序：
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
再次，这与伴侣“compose.cmd”包含：
cscript compose.vbs youraccessapplication.adp
它会要求您确认覆盖当前的应用程序，并首先创build备份。 然后它收集源目录中的所有源文件并将其重新插入到存根中。
玩的开心！
它似乎是在Access中可用的东西：
msdn的这个链接解释了如何为Microsoft Access安装一个源代码pipe理加载项。 作为Access Developer Access Extensions for Access 2007的一部分免费下载，并作为Access 2003的一个单独的免费加载项。
我很高兴你问了这个问题，我花时间来查看它，因为我也希望这个能力。 上面的链接有更多这方面的信息和链接到加载项。
更新：
我安装了Access 2003的加载项。它只能与VSS一起工作，但它允许我将Access对象（表单，查询，表，模块等）放入存储库。 当你去编辑回购中的任何项目时，你都被要求检查出来，但是你不需要。 接下来，我将检查如何处理在没有加载项的系统上被打开和更改。 我不是VSS的粉丝，但是我确实喜欢将访问对象存储在回购站中的想法。
UPDATE2：
没有加载项的机器无法对数据库结构进行任何更改（添加表字段，查询参数等）。 起初，我认为这可能是一个问题，如果有人需要，因为没有明显的方式来删除Access控制器的数据库，如果Access没有加载的加载项。
Id发现运行“compact and repair”数据库会提示您是否要从源代码pipe理中删除数据库。 我select了是，并能够编辑数据库没有加载项。 上面的链接中的文章也给出了设置Access 2003和2007以使用Team System的说明。 如果你可以find一个SVN的MSSCCI提供者，那么你很可能可以得到这个工作。
Olivers回答岩石，但CurrentProject参考不适合我。 我最终把他的出口中间的东西掏出来，并用Arvin Meyer的类似解决scheme来取代它。 具有导出查询的优点，如果您使用的是mdb而不是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
Oliver发布的撰写/分解解决scheme非常棒，但也存在一些问题：
- 这些文件被编码为UCS-2（UTF-16），这可能会导致版本控制系统/工具将文件视为二进制文件。
- 这些文件包含很多经常变化的文件 – 校验和，打印机信息等等。 这是一个严重的问题，如果你想干净的差异或需要合作的项目。
我打算自己解决这个问题，但发现已经有一个很好的解决scheme：GitHub上的timabell / msaccess-vcs-integration 。 我已经testing了msaccess-vcs-integration，它工作得很好。
2015年3月3日更新 ：该项目原来由bkidwell在Github上维护/拥有，但被转移到了timabell–项目上面的链接被相应更新。 bkidwell的原始项目中有一些叉子，例如ArminBra和matonb ，AFAICT不应该使用。
与Olivers的分解解决scheme相比，使用msaccess-vcs-integration的缺点是：
- 这是显着慢。 我敢肯定，速度问题可以解决，但我不需要将我的项目导出到经常的文本…
- 它不会创build一个存根删除导出的东西存根项目。 这也可以通过采用分解脚本中的代码来解决，但是又不是那么重要。
无论如何，我明确的build议是msaccess-vcs-integration。 它解决了我在导出的文件上使用Git时遇到的所有问题。
我们开发了我们自己的内部工具，其中：
- 模块：导出为txt文件，然后与“文件比较工具”（免费软件）
- 表单：通过无文件application.saveAsText命令导出。 然后可以看到两个不同版本（“文件比较工具”再次）之间的差异。
- macros：我们没有任何macros来比较，因为我们只有一行启动主VBA过程的“autoexec”macros
- 查询：只是存储在表中的文本string：请参见下文
- 表：我们写了我们自己的表比较器，列出了logging和表结构的差异。
整个系统足够聪明，可以让我们生成我们的Access应用程序的“运行时”版本，这些版本是由txt文件（模块和正在用非文档application.loadFromText命令重新创build的表单）和mdb文件（表格）自动生成的。
这可能听起来很奇怪，但是很有效。
基于这篇文章的想法和一些博客中的类似条目，我写了一个与mdb和adp文件格式一起使用的应用程序。 它将所有数据库对象（包括表，引用，关系和数据库属性）导入/导出为纯文本文件。 使用这些文件，您可以使用任何源代码版本控制。 下一个版本将允许将纯文本文件导回到数据库。 还会有一个命令行工具
您可以从http://accesssvn.codeplex.com/下载应用程序或源代码。;
问候
复活旧的线程，但这是一个很好的。 我已经为我自己的项目实现了两个脚本（compose.vbs / decompose.vbs），并遇到了旧的.mdb文件的问题：
它到达包含代码的表单时会停顿：
NoSaveCTIWhenDisabled =1
Access表示它有问题，这就是故事的结尾。 我跑了一些testing，并尝试解决这个问题，发现这个线程在最后的工作：
无法创build数据库
基本上（如果线程死了），你采取.mdb并做一个“另存为”新的.accdb格式。 然后源安全或撰写/分解的东西将工作。 我还必须玩10分钟才能获得正确的命令行语法（de）撰写脚本正常工作，所以这里的信息：
撰写（说你的东西位于C：\ SControl（创build一个名为源来存储提取的文件的子文件夹）：
'(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\
而已！
我遇到上述问题的Access版本包括Access 2000-2003“.mdb”数据库，并在运行撰写/分解脚本之前将其保存到2007-2010“.accdb”格式中，以解决此问题。 转换后的脚本工作得很好！
有一个问题–VSS 6.0只能接受MDB在一定数量的对象下使用插件，其中包括所有本地表，查询，模块和表单。 不知道确切的对象限制。
为了构build我们10年前的庞大应用程序，我们不得不将三个或四个单独的MDB结合到一个MDB中，这使得自动化构build变得复杂，我们不会浪费时间做这件事。
我想我会尝试上面的脚本将这个MDb发送到SVN，并简化每个人的构build。
这个脚本不适合我们。
这确实： http : //www.accessmvp.com/Arvin/DocDatabase.txt
对于那些使用Access 2010的人来说，SaveAsText在Intellisense中不是一个可见的方法，但它似乎是一个有效的方法，因为前面提到的 Arvin Meyer的脚本对我来说工作的很好。
有趣的是， SaveAsAXL是2010年的新增function，与SaveAsText具有相同的签名，但似乎仅适用于需要SharePoint Server 2010的Web数据库。
我们前一阵子有同样的问题。
我们的第一个尝试是一个第三方工具，它提供了Subversion的SourceSafe API代理，用于MS Access和VB 6.可以在这里find工具。
由于我们并不满意这个工具，我们切换到Visual SourceSafe和VSS访问插件。
我在SourceForge上find了这个工具： http : //sourceforge.net/projects/avc/
我还没有使用过，但这可能是你的开始。 可能还有一些其他第三方工具与VSS或SVN集成，可以满足您的需求。
就我个人而言，我只是保持一个纯文本文件方便保持更改日志。 当我提交二进制MDB时，我使用更改日志中的条目作为我的提交注释。
为了完整性…
总是有“用于Microsoft Office System的Visual Studio [YEAR]工具”（ http://msdn.microsoft.com/zh-cn/vs2005/aa718673.aspx ），但似乎需要VSS。 对我来说，VSS（自动腐蚀）比我的超级networking共享上的347个保存点差。
我正在使用Access 2003加载项：源代码pipe理 。 它工作正常。 一个问题是像“：”这样的无效字符。
我正在办理登机手续 内部插件和上面的代码一样，但是有更多的工具支持。 我可以看到一个对象是否签出并刷新对象。
您也可以将MS Access连接到Team Foundation Server。 还有一个免费的Express变种，可供多达5位开发人员使用。 工作得很好！
- 英文指南
- Team Foundation Server 2012 Express
编辑：固定链接
奥利弗的回答很好。 请在下面find我的扩展版本，增加了对Access查询的支持。
（请参阅Oliver的回答以获取更多信息/使用方法）
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'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 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.
希望有所帮助！
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.
只是一个想法。
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.
One of my other resources while working on this script was this answer , which helped me to figure out how to export relationships.
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
