我们用 VBScript 编写了自己的脚本,该脚本使用 Access 中未记录的 Application.SaveAsText() 来导出所有代码、表单、宏和报告模块。就在这里,它应该给你一些指导。 (注意:有些消息是德语的,但您可以轻松更改。)
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()
.)
分解.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
如果您需要可单击的命令,请使用以下命令创建一个名为“decompose.cmd”的文件,而不是使用命令行
cscript decompose.vbs youraccessapplication.adp
默认情况下,所有导出的文件都会进入 Access 应用程序的“Scripts”子文件夹中。 .adp/mdb 文件也被复制到此位置(带有“stub”后缀)并删除所有导出的模块,使其非常小。
您必须将此存根与源文件一起签入,因为大多数访问设置和自定义菜单栏无法以任何其他方式导出。如果您确实更改了某些设置或菜单,请务必仅提交对此文件的更改。
注意:如果您的应用程序中定义了任何 Autoexec-Makros,则在调用分解时可能必须按住 Shift 键,以防止它执行并干扰导出!
当然,还有反向脚本,从“源”目录构建应用程序:
撰写.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
它会要求您确认覆盖当前的应用程序,并首先创建备份(如果您这样做)。然后它收集源目录中的所有源文件并将它们重新插入到存根中。
玩得开心!