web-dev-qa-db-ja.com

Access開発でバージョン管理をどのように使用しますか?

Accessソリューションの更新に関与しています。大量のVBA、多数のクエリ、少量のテーブル、およびデータ入力とレポート生成用のいくつかのフォームがあります。 Accessの理想的な候補です。

テーブルデザイン、VBA、クエリ、およびフォームに変更を加えたい。バージョン管理で変更を追跡するにはどうすればよいですか? (私たちはSubversionを使用していますが、これはどんなフレーバーにも当てはまります)mdb全体をSubversionに貼り付けることはできますが、それはバイナリファイルを格納するものであり、VBAコードの1行を変更しただけだとは言えません。

VBAコードを別のファイルにコピーして保存することを考えましたが、データベースの内容とすぐに同期が取れなくなることがわかりました。

159
Nathan DeWitt

VBScriptで独自のスクリプトを作成し、Accessで文書化されていないApplication.SaveAsText()を使用して、すべてのコード、フォーム、マクロ、およびレポートモジュールをエクスポートします。ここに、いくつかのポインタがあります。 (注意:一部のメッセージはドイツ語ですが、簡単に変更できます。)

編集:以下のさまざまなコメントを要約するには: このプロジェクトでは、.adpファイルを想定しています。 .mdb/.accdbでこの機能を使用するには、OpenAccessProject()をOpenCurrentDatabase()に変更する必要があります。 (.adp拡張子が見つかった場合はOpenAccessProject()を使用するように更新され、それ以外の場合は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ファイルもこの場所にコピーされ(「スタブ」接尾辞付き)、エクスポートされたすべてのモジュールが削除されるため、非常に小さくなります。

ほとんどのアクセス設定とカスタムメニューバーは他の方法でエクスポートできないため、このスタブをソースファイルでチェックインする必要があります。設定やメニューを実際に変更した場合にのみ、このファイルに変更をコミットしてください。

注:アプリケーションでAutoexec-Makrosを定義している場合、分解を実行してエクスポートを妨げるのを防ぐために、分解を呼び出すときにShiftキーを押したままにする必要がある場合があります。

もちろん、「ソース」ディレクトリからアプリケーションをビルドするためのリバーススクリプトもあります。

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

現在のアプリケーションを上書きすることを確認するように求められ、必要に応じて最初にバックアップが作成されます。次に、Source-Directory内のすべてのソースファイルを収集し、それらをスタブに再挿入します。

楽しんで!

178
Oliver

Accessで非常に利用可能なもののようです。

この link msdnから、Microsoft Access用のソース管理アドインのインストール方法が説明されています。これは、Access 2007用のAccess Developer Extensionsの一部として、およびAccess 2003用の個別の無料アドインとして無料でダウンロードして出荷されました。

あなたがこの質問をしてくれてうれしいです。この能力も欲しいので、時間をかけて調べました。上記のリンクには、これに関する詳細とアドインへのリンクがあります。

更新:
Access 2003のアドインをインストールしました。VSSでのみ動作しますが、Accessオブジェクト(フォーム、クエリ、テーブル、モジュール、ect)をリポジトリに配置できます。リポジトリ内のアイテムを編集する場合、チェックアウトするように求められますが、その必要はありません。次に、アドインなしのシステムで開かれ、変更された場合の処理​​方法を確認します。私はVSSのファンではありませんが、アクセスオブジェクトをレポジトリに保存するという考えは本当に好きです。

Update2:
アドインのないマシンは、データベース構造に変更を加えることができません(テーブルフィールド、クエリパラメーターなどを追加します)。 Accessにアドインがロードされていない場合、ソース管理からAccessデータベースを削除する明確な方法がなかったため、最初はこれが問題になる可能性があると考えました。

Idは、データベースをソース管理から削除する場合、「コンパクトおよび修復」データベースを実行するとプロンプトが表示されることを発見しました。はいを選択し、アドインなしでデータベースを編集できました。上記の link の記事には、Team Systemを使用するようにAccess 2003および2007をセットアップする手順も記載されています。 SVNのMSSCCIプロバイダーを見つけることができれば、それが機能する可能性は十分にあります。

19
Brettski

オリバーズは岩に答えますが、CurrentProject参照は機能しませんでした。 Arvin Meyer による同様の解決策に基づいて、私は最終的に彼のエクスポートの途中から勇気を取り除いてこれに置き換えました。 adpの代わりにmdbを使用している場合、クエリをエクスポートする利点があります。

' 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
14
DaveParillo

Oliverが投稿した作成/分解ソリューションは素晴らしいですが、いくつかの問題があります。

  • ファイルはUCS-2(UTF-16)としてエンコードされ、バージョン管理システム/ツールがファイルをバイナリと見なす可能性があります。
  • ファイルには、チェックサム、プリンター情報など、頻繁に変更される多くの問題が含まれています。これは、クリーンなdiffが必要な場合、またはプロジェクトで協力する必要がある場合、深刻な問題です。

私は自分でこれを修正することを計画していましたが、すでに良い解決策があることを発見しました: timabell/msaccess-vcs-integration on GitHub。私はmsaccess-vcs-integrationをテストしましたが、うまく機能します。

2015年3月3日に更新:プロジェクトはもともとGithubのbkidwellによって維持/所有されていましたが、それは timabellに転送 -上記のプロジェクトへのリンクはそれに応じて更新されます。 bkidwellによる元のプロジェクトからのいくつかの分岐点があります。例えば、 by ArminBraby matonb で、これはAFAICTは使用すべきではありません。

Oliversの分解ソリューションと比較したmsaccess-vcs-integrationを使用することの欠点:

  • かなり遅いです。速度の問題は修正できると確信していますが、プロジェクトを頻繁にテキストにエクスポートする必要はありません...
  • エクスポートされたものが削除されたスタブAccessプロジェクトは作成されません。これは(decomposeスクリプトからコードを採用することで)修正することもできますが、やはり重要ではありません。

とにかく、私の明確な推奨事項はmsaccess-vcs-integrationです。エクスポートされたファイルでGitを使用していた問題をすべて解決しました。

13
hansfn

私たちは独自の内部ツールを開発しました。

  1. モジュール:txtファイルとしてエクスポートされ、「ファイル比較ツール」(フリーウェア)と比較されます
  2. フォーム:undocument application.saveAsTextコマンドを使用してエクスポートされます。これにより、2つの異なるバージョンの違いを確認できます(「ファイル比較ツール」)。
  3. マクロ:比較するマクロはありません。メインVBAプロシージャを起動する1行の "autoexec"マクロしかありません。
  4. クエリ:テーブルに保存された単なるテキスト文字列です。以下を参照してください
  5. テーブル:レコードの違いとテーブル構造をリストする独自のテーブル比較ツールを作成しました。

システム全体は、txtファイル(モジュール、およびundocument application.loadFromTextコマンドで再作成されるフォーム)およびmdbファイル(テーブル)から自動的に生成されるAccessアプリケーションの「ランタイム」バージョンを作成できるほどスマートです。

奇妙に聞こえるかもしれませんが、動作します。

11

この投稿のアイデアといくつかのブログの同様のエントリに基づいて、mdbおよびadpファイル形式で動作するアプリケーションを作成しました。すべてのデータベースオブジェクト(テーブル、参照、関係、データベースプロパティを含む)をプレーンテキストファイルにインポート/エクスポートします。これらのファイルを使用して、任意のソースバージョン管理を操作できます。次のバージョンでは、プレーンテキストファイルをデータベースにインポートできるようになります。コマンドラインツールもあります

次の場所からアプリケーションまたはソースコードをダウンロードできます。 http://accesssvn.codeplex.com/

よろしく

9
mnieto

古いスレッドを復活させるが、これは良いスレッドです。私は自分のプロジェクトに2つのスクリプト(compose.vbs/compose.vbs)を実装しましたが、古い.mdbファイルで問題が発生しました。

コードを含むフォームに到達すると停止します。

NoSaveCTIWhenDisabled =1

Accessには問題があると言われ、それで話は終わりです。私はいくつかのテストを実行し、この問題を回避しようとしていましたが、このスレッドは最後に回避策を見つけました:

データベースを作成できません

基本的に(スレッドが停止した場合)、. mdbを取得し、新しい.accdb形式に「名前を付けて保存」を行います。その後、ソースセーフまたは構成/分解のものが動作します。また、(de)composeスクリプトが正しく機能するための適切なコマンドライン構文を取得するために10分間遊んでいたので、その情報もここにあります。

作成するには(たとえば、あなたのコンテンツはC:\ SControlにあります(抽出されたファイルを保存するSourceという名前のサブフォルダーを作成します):

'(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"データベースが含まれ、compose/decomposeスクリプトを実行する前に2007-2010 ".accdb"形式に保存することで問題を修正しました。変換後、スクリプトは正常に機能します!

5
JKK

テキストファイルのみのソリューション(クエリ、テーブル、および関係が含まれます)

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
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

cscript decompose.vbs <path to file to decompose> <folder to store text files>を呼び出すことにより、このスクリプトを実行できます。 2番目のパラメーターを省略すると、データベースが存在する「ソース」フォルダーが作成されます。宛先フォルダーが既に存在する場合は消去されることに注意してください。

エクスポートされたテーブルにデータを含める

93行目を置換:oApplication.ExportXML acExportTable, myObj.Name, , sExportpath & "\" & myObj.Name & ".table.txt"

oApplication.ExportXML acExportTable, myObj.Name, sExportpath & "\" & myObj.Name & ".table.txt"

にインポート データベースファイル(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

cscript compose.vbs <path to file which should be created> <folder with text files>を呼び出すことにより、このスクリプトを実行できます。 2番目のパラメーターを省略すると、データベースが作成される「ソース」フォルダーが検索されます。

テキストファイルからデータをインポートする

行14:const acStructureOnly = 0const acStructureOnly = 1に置き換えます。これは、エクスポートされたテーブルにデータを含めた場合にのみ機能します。

カバーされていないもの

  1. これは.accdbファイルでのみテストしているため、他のファイルではバグが発生する可能性があります。
  2. 設定はエクスポートされません。データベースの起動時に設定を適用するマクロを作成することをお勧めします。
  3. 先頭に「〜」が付いている不明なクエリがエクスポートされることがあります。それらが必要かどうかはわかりません。
  4. MSAccessオブジェクト名には、ファイル名には無効の文字を含めることができます-スクリプトは、それらを書き込もうとすると失敗します。 すべてのファイル名を正規化する を使用できますが、インポートして戻すことはできません。

このスクリプトの作成中の他のリソースの1つは この回答 で、これは関係をエクスポートする方法を見つけるのに役立ちました。

4
Jakub M.

しばらく前に同じ問題が発生しました。

最初の試みは、MS AccessおよびVB 6.で使用されるSubversionのSourceSafe APIのプロキシを提供するサードパーティツールでした。ツールは here にあります。

そのツールに満足していないため、Visual SourceSafeとVSS Accesプラグインに切り替えました。

2
Benjamin Brauer

Access 2010を使用している場合、SaveAsTextはIntellisenseで目に見えるメソッドではありませんが、Arvin Meyerのスクリプト 前述 でうまく機能したため、有効なメソッドのようです。

興味深いことに、 SaveAsAXL は2010の新機能であり、SaveAsTextと同じ署名を持っていますが、SharePoint Server 2010を必要とするWebデータベースでのみ機能するようです。

2
Cory

落とし穴があります-VSS 6.0は、すべてのローカルテーブル、クエリ、モジュール、およびフォームを含む特定の数のオブジェクトの下で、アドインを使用したMDBのみを受け入れることができます。オブジェクトの正確な制限がわからない。

巨大な10年前の製品フロアアプリを構築するには、SSから3つまたは4つの個別のMDBを1つのMDBに結合する必要があります。

上記のスクリプトを試して、このMDbをSVNに吐き出し、すべての人のビルドを簡素化すると思います。

2
ChuckB

MS AccessをTeam Foundation Serverに接続することもできます。最大5人の開発者向けの無料のExpressバリアントもあります。本当にうまくいく!

編集:固定リンク

1
WolfgangP

完全を期すために...

「Microsoft Office SystemのVisual Studio [YEAR]ツール」は常にあります( http://msdn.Microsoft.com/en-us/vs2005/aa718673.aspx )が、VSSが必要なようです。私にとって、VSS(自動破損)は、uberバックアップされたネットワーク共有上の347個のセーブポイントよりも悪いです。

1
BIBD

Oasis-Svnを使用しています http://dev2dev.de/

少なくとも一度は救われたと言えます。私のmdbは2 GBを超えて成長していたので、壊れました。古いバージョンに戻ってフォームをインポートすると、1日かそこらで仕事を失いました。

1
Friedrich

SourceForgeでこのツールを見つけました。 http://sourceforge.net/projects/avc/

私はそれを使用していませんが、それはあなたのためのスタートかもしれません。 VSSまたはSVNと統合して、必要なことを行う他のサードパーティツールが存在する場合があります。

個人的には、変更ログを保持するためにプレーンテキストファイルを手元に置いています。バイナリMDBをコミットするとき、変更ログのエントリをコミットコメントとして使用します。

1
Patrick Cuff

Access 2003アドイン:ソースコード管理 を使用しています。正常に動作します。 1つの問題は、「:」のような無効な文字です。

チェックインとチェックアウトをしています。内部的には、アドインはそこまでのコードと同じことをしますが、より多くのツールをサポートします。オブジェクトがチェックアウトされているかどうかを確認し、オブジェクトを更新できます。

1
Summer-Time

オリバーからの答えは素晴らしい作品です。 Accessクエリのサポートを追加する以下の拡張バージョンを見つけてください。

(詳細は/ オリバーからの回答を参照 してください)

分解.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
1

このエントリは、他のエントリとはまったく異なるアプローチを説明しており、探しているものとは異なる場合があります。したがって、これを無視しても気になりません。しかし、少なくともそれは思考の糧です。

一部のプロフェッショナルな商用ソフトウェア開発環境では、ソフトウェア成果物の構成管理(CM)は通常行われませんwithinソフトウェアアプリケーション自体またはソフトウェアプロジェクト自体。 CMは、ファイルとそのフォルダーの両方がバージョンIDでマークされている特別なCMフォルダーにソフトウェアを保存することにより、最終的な成果物に課せられます。たとえば、Clearcaseを使用すると、データマネージャーはソフトウェアファイルを「チェックイン」し、「ブランチ」を割り当て、「バブル」を割り当て、「ラベル」を適用できます。ファイルを表示してダウンロードしたい場合は、「構成仕様」を構成して、目的のバージョンを指すようにし、そのフォルダーにcdして、そこにある必要があります。

ただのアイデア。

私は、アクセスデータベース内にクエリのエクスポートオプションを追加することで、彼の答えに貢献しようとしました。 ( 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

それを「compose」機能に戻すことはできませんが、今はそれが必要なことではありません。

注:また、decompose.vbsのエクスポートされたファイル名のそれぞれに「.txt」を追加して、ソース管理がすぐにファイルの差分を表示するようにしました。

お役に立てば幸いです!


0
JBickford

Access 97にこだわっている人にとっては、他の答えを得ることができませんでした。 Oliver'sDaveParillo's の優れた回答といくつかの修正を組み合わせて使用​​することで、Access 97データベースでスクリプトを機能させることができました。また、どのフォルダーにファイルを配置するかを尋ねるので、ユーザーフレンドリーです。

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

また、データベースにファイルをインポートするために、データベースを最初から再作成する必要がある場合、または何らかの理由でAccessの外部でファイルを変更する場合。

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
0
CTristan