Access（.mdb）データベースのスキーマを抽出する方法は？

Question

.mdbデータベースのスキーマを抽出して、データベースを別の場所に再作成できるようにしています。

このようなものをどうやって取り除くことができますか？

Answer 1

VBAで少し行うことは可能です。たとえば、ローカルテーブルを使用したデータベースのスクリプトの作成を開始します。

Dim db As Database
Dim tdf As TableDef
Dim fld As DAO.Field
Dim ndx As DAO.Index
Dim strSQL As String
Dim strFlds As String
Dim strCn As String

Dim fs, f

    Set db = CurrentDb

    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.CreateTextFile("C:\Docs\Schema.txt")

    For Each tdf In db.TableDefs
        If Left(tdf.Name, 4) <> "Msys" Then
            strSQL = "strSQL=""CREATE TABLE [" & tdf.Name & "] ("

            strFlds = ""

            For Each fld In tdf.Fields

                strFlds = strFlds & ",[" & fld.Name & "] "

                Select Case fld.Type

                    Case dbText
                        'No look-up fields
                        strFlds = strFlds & "Text (" & fld.Size & ")"

                    Case dbLong
                        If (fld.Attributes And dbAutoIncrField) = 0& Then
                            strFlds = strFlds & "Long"
                        Else
                            strFlds = strFlds & "Counter"
                        End If

                    Case dbBoolean
                        strFlds = strFlds & "YesNo"

                    Case dbByte
                        strFlds = strFlds & "Byte"

                    Case dbInteger
                        strFlds = strFlds & "Integer"

                    Case dbCurrency
                        strFlds = strFlds & "Currency"

                    Case dbSingle
                        strFlds = strFlds & "Single"

                    Case dbDouble
                        strFlds = strFlds & "Double"

                    Case dbDate
                        strFlds = strFlds & "DateTime"

                    Case dbBinary
                        strFlds = strFlds & "Binary"

                    Case dbLongBinary
                        strFlds = strFlds & "OLE Object"

                    Case dbMemo
                        If (fld.Attributes And dbHyperlinkField) = 0& Then
                            strFlds = strFlds & "Memo"
                        Else
                            strFlds = strFlds & "Hyperlink"
                        End If

                    Case dbGUID
                        strFlds = strFlds & "GUID"

                End Select

            Next

            strSQL = strSQL & Mid(strFlds, 2) & " )""" & vbCrLf & "Currentdb.Execute strSQL"

            f.WriteLine vbCrLf & strSQL

            'Indexes
            For Each ndx In tdf.Indexes

                If ndx.Unique Then
                    strSQL = "strSQL=""CREATE UNIQUE INDEX "
                Else
                    strSQL = "strSQL=""CREATE INDEX "
                End If

                strSQL = strSQL & "[" & ndx.Name & "] ON [" & tdf.Name & "] ("

                strFlds = ""

                For Each fld In tdf.Fields
                    strFlds = ",[" & fld.Name & "]"
                Next

                strSQL = strSQL & Mid(strFlds, 2) & ") "

                strCn = ""

                If ndx.Primary Then
                    strCn = " PRIMARY"
                End If

                If ndx.Required Then
                    strCn = strCn & " DISALLOW NULL"
                End If

                If ndx.IgnoreNulls Then
                    strCn = strCn & " IGNORE NULL"
                End If

                If Trim(strCn) <> vbNullString Then
                    strSQL = strSQL & " WITH" & strCn & " "
                End If

                f.WriteLine vbCrLf & strSQL & """" & vbCrLf & "Currentdb.Execute strSQL"
            Next
        End If
    Next

    f.Close

Answer 2

それは今では古代の質問ですが、残念ながら多年生です:(

このコードは解決策を探している他の人に役立つかもしれないと思いました。コマンドラインからcscriptを介して実行するように設計されているため、Accessプロジェクトにコードをインポートする必要はありません。 Oliver in Access開発でバージョン管理をどのように使用しますか のコードに似ています（そしてそれに触発されています）。

' Usage:
'  CScript //Nologo ddl.vbs <input mdb file> > <output>
'
' Outputs DDL statements for tables, indexes, and relations from Access file 
' (.mdb, .accdb) <input file> to stdout.  
' Requires Microsoft Access.
'
' NOTE: Adapted from code from "polite person" + Kevin Chambers - see:
' http://www.mombu.com/Microsoft/comp-databases-ms-access/t-exporting-jet-table-metadata-as-text-119667.html
'
Option Explicit
Dim stdout, fso
Dim strFile
Dim appAccess, db, tbl, idx, rel

Set stdout = WScript.StdOut
Set fso = CreateObject("Scripting.FileSystemObject")

' Parse args
If (WScript.Arguments.Count = 0) then
    MsgBox "Usage: cscript //Nologo ddl.vbs access-file", vbExclamation, "Error"
    Wscript.Quit()
End if
strFile = fso.GetAbsolutePathName(WScript.Arguments(0))

' Open mdb file
Set appAccess = CreateObject("Access.Application")
appAccess.OpenCurrentDatabase strFile
Set db = appAccess.DBEngine(0)(0)

' Iterate over tables
  ' create table statements
For Each tbl In db.TableDefs
  If Not isSystemTable(tbl) And Not isHiddenTable(tbl) Then
    stdout.WriteLine getTableDDL(tbl)
    stdout.WriteBlankLines(1)

    ' Iterate over indexes
      ' create index statements
    For Each idx In tbl.Indexes
      stdout.WriteLine getIndexDDL(tbl, idx)
    Next

    stdout.WriteBlankLines(2)
  End If
Next

' Iterate over relations
  ' alter table add constraint statements
For Each rel In db.Relations
  Set tbl = db.TableDefs(rel.Table)
  If Not isSystemTable(tbl) And Not isHiddenTable(tbl) Then
    stdout.WriteLine getRelationDDL(rel)
    stdout.WriteBlankLines(1)
  End If
Next

Function getTableDDL(tdef)
Const dbBoolean = 1
Const dbByte = 2
Const dbCurrency = 5
Const dbDate = 8
Const dbDouble = 7
Const dbInteger = 3
Const dbLong = 4
Const dbDecimal = 20
Const dbFloat = 17
Const dbMemo = 12
Const dbSingle = 6
Const dbText = 10
Const dbGUID = 15
Const dbAutoIncrField = 16

Dim fld
Dim sql
Dim ln, a

    sql = "CREATE TABLE " & QuoteObjectName(tdef.name) & " ("
    ln = vbCrLf

    For Each fld In tdef.fields
       sql = sql & ln & " " & QuoteObjectName(fld.name) & " "
       Select Case fld.Type
       Case dbBoolean   'Boolean
          a = "BIT"
       Case dbByte   'Byte
          a = "BYTE"
       Case dbCurrency  'Currency
          a = "MONEY"
       Case dbDate 'Date / Time
          a = "DATETIME"
       Case dbDouble    'Double
          a = "DOUBLE"
       Case dbInteger   'Integer
          a = "INTEGER"
       Case dbLong  'Long
          'test if counter, doesn't detect random property if set
          If (fld.Attributes And dbAutoIncrField) Then
             a = "COUNTER"
          Else
             a = "LONG"
          End If
       Case dbDecimal    'Decimal
          a = "DECIMAL"
       Case dbFloat      'Float
          a = "FLOAT"
       Case dbMemo 'Memo
          a = "MEMO"
       Case dbSingle    'Single
          a = "SINGLE"
       Case dbText 'Text
          a = "VARCHAR(" & fld.Size & ")"
       Case dbGUID 'Text
          a = "GUID"
       Case Else
          '>>> raise error
          MsgBox "Field " & tdef.name & "." & fld.name & _
                " of type " & fld.Type & " has been ignored!!!"
       End Select

       sql = sql & a

       If fld.Required Then _
          sql = sql & " NOT NULL "
       If Len(fld.DefaultValue) > 0 Then _
          sql = sql & " DEFAULT " & fld.DefaultValue

       ln = ", " & vbCrLf
    Next

    sql = sql & vbCrLf & ");"
    getTableDDL = sql

End Function

Function getIndexDDL(tdef, idx)
Dim sql, ln, myfld

    If Left(idx.name, 1) = "{" Then
       'ignore, GUID-type indexes - bugger them
    ElseIf idx.Foreign Then
       'this index was created by a relation.  recreating the
       'relation will create this for us, so no need to do it here
    Else
       ln = ""
       sql = "CREATE "
       If idx.Unique Then
           sql = sql & "UNIQUE "
       End If
       sql = sql & "INDEX " & QuoteObjectName(idx.name) & " ON " & _
             QuoteObjectName(tdef.name) & "( "
       For Each myfld In idx.fields
          sql = sql & ln & QuoteObjectName(myfld.name)
          ln = ", "
       Next
       sql = sql & " )"
       If idx.Primary Then
          sql = sql & " WITH PRIMARY"
       ElseIf idx.IgnoreNulls Then
          sql = sql & " WITH IGNORE NULL"
       ElseIf idx.Required Then
          sql = sql & " WITH DISALLOW NULL"
       End If
       sql = sql & ";"
    End If
    getIndexDDL = sql

End Function

' Returns the SQL DDL to add a relation between two tables.
' Oddly, DAO will not accept the ON DELETE or ON UPDATE
' clauses, so the resulting sql must be executed through ADO
Function getRelationDDL(myrel)
Const dbRelationUpdateCascade = 256
Const dbRelationDeleteCascade = 4096
Dim mytdef
Dim myfld
Dim sql, ln


    With myrel
       sql = "ALTER TABLE " & QuoteObjectName(.ForeignTable) & _
             " ADD CONSTRAINT " & QuoteObjectName(.name) & " FOREIGN KEY ( "
       ln = ""
       For Each myfld In .fields 'ie fields of the relation
          sql = sql & ln & QuoteObjectName(myfld.ForeignName)
          ln = ","
       Next
       sql = sql & " ) " & "REFERENCES " & _
             QuoteObjectName(.table) & "( "
       ln = ""
       For Each myfld In .fields
          sql = sql & ln & QuoteObjectName(myfld.name)
          ln = ","
       Next
       sql = sql & " )"
       If (myrel.Attributes And dbRelationUpdateCascade) Then _
             sql = sql & " ON UPDATE CASCADE"
       If (myrel.Attributes And dbRelationDeleteCascade) Then _
             sql = sql & " ON DELETE CASCADE"
       sql = sql & ";"
    End With
    getRelationDDL = sql
End Function


Function isSystemTable(tbl)
Dim nAttrib
Const dbSystemObject = -2147483646
    isSystemTable = False
    nAttrib = tbl.Attributes
    isSystemTable = (nAttrib <> 0 And ((nAttrib And dbSystemObject) <> 0))
End Function

Function isHiddenTable(tbl)
Dim nAttrib
Const dbHiddenObject = 1
    isHiddenTable = False
    nAttrib = tbl.Attributes
    isHiddenTable = (nAttrib <> 0 And ((nAttrib And dbHiddenObject) <> 0))
End Function

Function QuoteObjectName(str)
    QuoteObjectName = "[" & str & "]"
End Function

クエリ定義もエクスポートする場合は、 この質問 が役立ちます。通常はプレーンなDDL CREATE VIEW foo AS ...構文でquerydefsを作成しないため、少し異なります。実際、できるかどうかはわかりません（？）

しかし、これは、クエリをバックアップして.sqlファイルを分離するために作成したスクリプトの一部です（これは、すべてのフロントエンドデータベースコードをバックアップするためのより大きなスクリプトの一部です。 この質問 に対するOliverの回答を参照してください。 ）。

Dim oApplication
Set oApplication = CreateObject("Access.Application")
oApplication.OpenCurrentDatabase sMyAccessFilePath
oApplication.Visible = False

For Each myObj In oApplication.DBEngine(0)(0).QueryDefs
    writeToFile sExportpath & "\queries\" & myObj.Name & ".sql", myObj.SQL 
Next

Function writeToFile(path, text)
Dim fso, st
  Set fso = CreateObject("Scripting.FileSystemObject")
  Set st = fso.CreateTextFile(path, True)
  st.Write text
  st.Close
End Function

Answer 3

次のC＃は、.mdbファイルからスキーマを取得する方法の概要を示しています。

データベースへの接続を取得します。

String f = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" + "database.mdb";
OleDbConnection databaseConnection = new OleDbConnection(f);
databaseConnection.Open();

各テーブルの名前を取得します。

DataTable dataTable = databaseConnection.GetOleDbSchemaTable(OleDbSchemaGuid.Tables, new object[] { null, null, null, "TABLE" });
int numTables = dataTable.Rows.Count;
for (int tableIndex = 0; tableIndex < numTables; ++tableIndex)
{
    String tableName = dataTable.Rows[tableIndex]["TABLE_NAME"].ToString();

各テーブルのフィールドを取得します。

    DataTable schemaTable = databaseConnection.GetOleDbSchemaTable(OleDbSchemaGuid.Columns, new object[] { null, null, tableName, null });
    foreach (DataRow row in schemaTable.Rows)
    {
        String fieldName = row["COLUMN_NAME"].ToString(); //3
        String fieldType = row["DATA_TYPE"].ToString(); // 11
        String fieldDescription = row["DESCRIPTION"].ToString(); //27
    }
}

3、11、および27はどこから来たのですか？デバッガーでDataRow.ItemArrayを調べて見つけましたが、「正しい」方法を知っている人はいますか？

Answer 4

ACE/Jet OLE DB ProviderとADO ConnectionオブジェクトのOpenSchemaメソッドを使用して、スキーマ情報をRecordsetとして取得できます（これはコレクションよりも優れています。フィルタリング、ソートなどが可能なため）。

基本的な方法は、adSchemaTablesを使用して（VIEWではなく）ベーステーブルを取得し、次に各TABLE_NAMEを使用してORDINAL_POSITION、！DATA_TYPE、！IS_NULLABLE、！COLUMN_HASDEFAULT、！COLUMN_DEFAULT、！CHARACTER_MAXPIM！ERIC_NUM_CREAM_NUMERIC_NUMERIC！NUM_ERIC！NUM_ERIC！NUM_ERIC_NUM！I！.

adSchemaPrimaryKeysは簡単です。 adSchemaIndexesは、一意の制約を見つける場所です。これらが一意のインデックスと区別できるかどうかはわかりません。また、adSchemaForeignKeys行セットにプラグインする外部キーの名前もあります。 （擬似コード）：

rsFK.Filter = "FK_NAME = '" & !INDEX_NAME & "'") 

--Jet 3.51が名前のないPKに基づくFKを許可するという落とし穴に注意してください（!!）

検証ルールとCHECK制約の名前は、OpenSchema呼び出しのテーブル名を使用して、adSchemaTableConstraints行セットで見つけることができます。次に、adSchemaCheckConstraints行セットの呼び出しでその名前を使用し、CONSTRAINT_TYPE = 'CHECK'をフィルター処理します（落とし穴は、 'ValidationRule' + Chr $（0）なので、名前からヌル文字をエスケープするのが最善です）。 ACE/Jet検証ルールは行レベルまたはテーブルレベルのいずれかであることに注意してください（CHECK制約は常にテーブルレベルです）。そのため、フィルターでテーブル名を使用する必要がある場合があります。adSchemaTableConstraintsの場合は[]。[]。ValidationRuleです。 adSchemaCheckConstraintsでは[] .ValidationRuleになります。もう1つの問題（疑わしいバグ）は、フィールドの幅が255文字であるため、255文字を超える検証ルール/チェック制約の定義にはNULL値が含まれることです。

パラメータ化されていないSELECTSQLDMLに基づくAccessQueryオブジェクトのadSchemaViewsは簡単です。 adSchemaColumnsでVIEW名を使用して、列の詳細を取得できます。

PROCEDURESはadSchemaProceduresにあり、パラメーター化されたSELECTDMLを含むAccessQueryオブジェクトの他のすべてのフレーバーです。後者の場合、PROCEDURE_DEFINITIONでPARAMETERS構文をCREATE PROCEDUREPROCEDURE_NAMEに置き換えることを好みます。 adSchemaProcedureParametersを検索しないでください。何も見つかりません。パラメーターは、ADOコマンドを返すADOX Catalogオブジェクトを使用して列挙できます（例：疑似コード）：

Set Command = Catalog.Procedures(PROCEDURE_NAME).Command

次に、DATA_TYPEの.Name、.TypeのComm.Parametersコレクション、IS_NULLABLEの（.Attributes And adParamNullable）、COLUMN_HASDEFAULTおよびCOLUMN_DEFAULTの.Value、.Size、.Precision、.NumericScaleを列挙します。

Unicode圧縮などのACE/Jet固有のプロパティの場合、別の種類のオブジェクトを使用する必要があります。たとえば、Access-speakの長整数オートナンバーは、ADOカタログオブジェクト（例：（擬似コード））を使用して見つけることができます。

bIsAutoincrement = Catalog.Tables(TABLE_NAME).Columns(COLUMN_NAME).Properties("Autoincrement").Value

幸運を ：）

Answer 5

Compare'Em http://home.gci.net/~mike-noel/CompareEM-LITE/CompareEM.htm MDBを再作成するために必要なVBAコードを問題なく生成します。または、既存のBEMDBのバージョンアップグレードを実行できるように2つのMDB間の差異を作成するコード。少し風変わりですが、機能します。新しいACE（Access2007）ACCDBなどの形式はサポートされていないことに注意してください。

いつも使っています。

（OneDayWhenの編集は3分の1が正しく、3分の2が間違っていました。）

Answer 6

Docmd . TransferDatabase コマンドを確認してください。データ構造を複製する必要があるビルド統合には、おそらく最善の策です。

Answer 7

AccessでDDLスクリプト/クエリを実行するのは困難です。それは可能ですが、データベースのコピーを作成するだけの方が良いでしょう-すべてのデータを削除して圧縮します。次に、このコピーを使用して、データベースを別の場所に再作成します。

Answer 8

とても参考になった投稿です！

スクリプトを改訂して、SQLサーバーのデータ定義言語を生成しました。誰かに役立つかもしれないと思ったので、共有しています。私が遭遇した問題の1つは、VBSスクリプトがテーブル内のすべてのフィールドをインデックス用に抽出することです。これを解決する方法がまだわからないので、最初のフィールドのみを抽出します。これはほとんどの主キーで機能します。最後に、すべてのデータ型が証明されているわけではありませんが、私はそれらのほとんどを取得したと思います。

Option Compare Database


Function exportTableDefs()

Dim db As Database
Dim tdf As TableDef
Dim fld As DAO.Field
Dim ndx As DAO.Index
Dim strSQL As String
Dim strFlds As String

Dim fs, f

    Set db = CurrentDb

    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.CreateTextFile("C:\temp\Schema.txt")

    For Each tdf In db.TableDefs
        If Left(tdf.Name, 4) <> "Msys" And Left(tdf.Name, 1) <> "~" Then
            strSQL = "CREATE TABLE [" & tdf.Name & "] (" & vbCrLf

            strFlds = ""

            For Each fld In tdf.Fields

                strFlds = strFlds & ",[" & fld.Name & "] "

                Select Case fld.Type

                    Case dbText
                        'No look-up fields
                        strFlds = strFlds & "varchar (" & fld.SIZE & ")"

                    Case dbLong
                        If (fld.Attributes And dbAutoIncrField) = 0& Then
                            strFlds = strFlds & "bigint"
                        Else
                            strFlds = strFlds & "int IDENTITY(1,1)"
                        End If

                    Case dbBoolean
                        strFlds = strFlds & "bit"

                    Case dbByte
                        strFlds = strFlds & "tinyint"

                    Case dbInteger
                        strFlds = strFlds & "int"

                    Case dbCurrency
                        strFlds = strFlds & "decimal(10,2)"

                    Case dbSingle
                        strFlds = strFlds & "decimal(10,2)"

                    Case dbDouble
                        strFlds = strFlds & "Float"

                    Case dbDate
                        strFlds = strFlds & "DateTime"

                    Case dbBinary
                        strFlds = strFlds & "binary"

                    Case dbLongBinary
                        strFlds = strFlds & "varbinary(max)"

                    Case dbMemo
                        If (fld.Attributes And dbHyperlinkField) = 0& Then
                            strFlds = strFlds & "varbinary(max)"
                        Else
                            strFlds = strFlds & "?"
                        End If

                    Case dbGUID
                        strFlds = strFlds & "?"
                    Case Else
                        strFlds = strFlds & "?"

                End Select
                strFlds = strFlds & vbCrLf

            Next

            ''  get rid of the first comma
            strSQL = strSQL & Mid(strFlds, 2) & " )" & vbCrLf

            f.WriteLine strSQL

            strSQL = ""

            'Indexes
            For Each ndx In tdf.Indexes

                If Left(ndx.Name, 1) <> "~" Then
                    If ndx.Primary Then
                        strSQL = "ALTER TABLE " & tdf.Name & " ADD  CONSTRAINT " & tdf.Name & "_primary" & " PRIMARY KEY CLUSTERED ( " & vbCrLf
                    Else
                        If ndx.Unique Then
                            strSQL = "CREATE UNIQUE NONCLUSTERED INDEX "
                        Else
                            strSQL = "CREATE NONCLUSTERED INDEX "
                        End If
                        strSQL = strSQL & "[" & tdf.Name & "_" & ndx.Name & "] ON [" & tdf.Name & "] ("
                    End If

                    strFlds = ""

                    '''  Assume that the index is only for the first field.  This will work for most primary keys
                    '''  Not sure how to get just the fields in the index
                    For Each fld In tdf.Fields
                        strFlds = strFlds & ",[" & fld.Name & "] ASC "
                        Exit For
                    Next

                    strSQL = strSQL & Mid(strFlds, 2) & ") "
                End If
            Next
           f.WriteLine strSQL & vbCrLf
        End If
    Next

    f.Close

End Function