私は Access ソリューションの更新に携わっています。このソリューションには、大量の VBA、多数のクエリ、少量のテーブル、およびデータ入力とレポート生成用のいくつかのフォームが含まれています。Access に最適なソリューションです。
テーブル デザイン、VBA、クエリ、およびフォームを変更したいと考えています。バージョン管理を使用して変更を追跡するにはどうすればよいですか? (私たちは Subversion を使用していますが、これはどのバージョンでも当てはまります) mdb 全体を Subversion に保存することはできますが、バイナリ ファイルを保存することになり、VBA コードの 1 行を変更しただけであることがわかりません。
VBA コードを別のファイルにコピーして保存することも考えましたが、データベースの内容とすぐに同期が取れなくなることがわかりました。
ベストアンサー1
私たちは、Access の文書化されていない Application.SaveAsText() を使用して、すべてのコード、フォーム、マクロ、レポート モジュールをエクスポートする独自のスクリプトを VBScript で作成しました。これがそのスクリプトです。いくつかのヒントになるはずです。(注意: 一部のメッセージはドイツ語ですが、簡単に変更できます。)
編集: 以下にさまざまなコメントを要約します:
このプロジェクトは .adp ファイルを想定しています。.mdb/.accdb でこれを動作させるには、OpenAccessProject() を OpenCurrentDatabase() に変更する必要があります。
. ( OpenAccessProject()
.adp 拡張子が見つかった場合は を使用し、そうでない場合は を使用するように更新されました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
現在のアプリケーションを上書きするかどうかを確認するメッセージが表示され、上書きする場合はまずバックアップが作成されます。次に、ソース ディレクトリ内のすべてのソース ファイルを収集し、スタブに再挿入します。
楽しむ!