问题描述
我们用 VBScript 编写了自己的脚本,该脚本使用 Access 中未记录的 Application.SaveAsText() 来导出所有代码、表单、宏和报表模块。在这里,它应该给你一些指示。(请注意:有些消息是德语的,但您可以轻松更改它。)
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
如果你需要一个可点击的命令,而不是使用命令行,创建一个名为“decompose.cmd”的文件
cscript decompose.vbs youraccessapplication.adp
默认情况下,所有导出的文件都进入 Access 应用程序的“脚本”子文件夹。.adp/mdb 文件也被复制到此位置(带有“存根”后缀)并去除所有导出的模块,使其非常小。
您必须使用源文件签入此存根,因为大多数访问设置和自定义菜单栏无法以任何其他方式导出。如果您确实更改了某些设置或菜单,请确保仅提交对此文件的更改。
注意:如果您的应用程序中定义了任何 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
它会要求您确认覆盖当前应用程序并首先创建备份(如果您这样做了)。然后它收集 Source-Directory 中的所有源文件并将它们重新插入到存根中。
解决方法
我参与更新 Access 解决方案。它有大量的 VBA、大量的查询、少量的表格以及一些用于数据输入和报告生成的表格。它是 Access 的理想选择。
我想对表设计、VBA、查询和表单进行更改。如何使用版本控制跟踪我的更改?(我们使用 Subversion,但这适用于任何风格)我可以将整个 mdb 粘贴到 subversion 中,但这将存储一个二进制文件,我无法判断我只是更改了一行 VBA 代码。
我曾考虑将 VBA 代码复制到单独的文件中并保存它们,但我可以看到这些代码很快与数据库中的内容不同步。