【问题标题】:How to extract the schema of an Access (.mdb) database?如何提取 Access (.mdb) 数据库的架构?
【发布时间】:2010-10-16 11:28:07
【问题描述】:

我正在尝试提取 .mdb 数据库的架构,以便可以在其他地方重新创建数据库。

我怎样才能完成这样的事情?

【问题讨论】:

标签: ms-access ms-jet-ace


【解决方案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 = 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

【讨论】:

  • 这真是太好了。如何获取默认值、外键等?
  • 需要使用ADO添加默认值。可以使用 CONSTRAINT ReferForeignField FOREIGN KEY(, ,..,) REFERENCES (, ,..,) 添加外键等我可以做些什么来添加到示例中。
  • 如果您使用的是 DAO,您应该使用关系集合来应用外键限制,不是吗?
  • 是的,但是如果要在 sql 中完成,就像大多数模式一样,我认为,它看起来应该是 ADO。如前所述,对于 DAO,最好的选择可能是简单地复制 mdb。是不是?
  • @David W. Fenton:DAO 模型不如 SQL DLL 语法丰富,例如DAO 仍然无法创建“快速外键”。我知道,我知道:您从未使用过快速外键,因此您不会错过它,但这仍然是一个限制:)
【解决方案2】:

现在这是一个古老的问题,但不幸的是长期存在:(

我认为此代码可能对寻找解决方案的其他人有用。它旨在通过 cscript 从命令行运行,因此无需将代码导入您的 Access 项目。与Oliver in How do you use version control with Access development 中的代码类似(并受其启发)。

' 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

如果您也想导出查询定义,this question 应该会有所帮助。这有点不同,因为您通常不会使用普通 DDL CREATE VIEW foo AS ... 语法创建查询定义,实际上我不确定您是否可以(?)

但这是我为将查询备份到单独的 .sql 文件而编写的一小段脚本(它是用于备份所有前端数据库代码的较大脚本的一部分,请参阅 Oliver 对this question 的回答)。

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

【讨论】:

  • 正如我上面评论的那样,如果这也包括查询定义会很棒。
  • @LondonRob:添加
  • 这仍然适用于 Windows 10 上的 Access 365。
【解决方案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
    }
}

31127 来自哪里?我通过调试器检查DataRow.ItemArray 找到了它们,有人知道“正确”的方法吗?

【讨论】:

  • 获取数据库中每一列的字段名:OleDbDataReader.GetName(i),其中i用于遍历每个字段索引号。 OleDbDataReader.GetFieldType(i) 返回列的数据类型。
  • 啊哈,我就知道一定有办法!干杯。
  • 我用你想要的行的实际字符串值更新了你的答案。我将在下面的答案中添加所有选项的屏幕截图。
  • 对于所有想知道屏幕截图在哪里的人,ProVega 已将其发布为进一步的答案
【解决方案4】:

如果您乐于使用纯 Access SQL 以外的其他东西,则可以保留 ADOX 对象的集合并使用这些对象重新创建表结构。

示例(在 Python 中,目前不重新创建关系和索引,因为我正在处理的项目不需要它):

import os
import sys
import datetime
import comtypes.client as client

class Db:
    def __init__(self, original_con_string = None, file_path = None,
                 new_con_string = None, localise_links = False):
        self.original_con_string = original_con_string
        self.file_path = file_path
        self.new_con_string = new_con_string
        self.localise_links = localise_links

    def output_table_structures(self, verbosity = 0):
        if os.path.exists(self.file_path):
            if not os.path.isdir(self.file_path):
                raise Exception("file_path must be a directory!")
        else:
            os.mkdir(self.file_path)
        cat = client.CreateObject("ADOX.Catalog")
        cat.ActiveConnection = self.original_con_string
        linked_tables = ()
        for table in cat.Tables:
            if table.Type == u"TABLE":
                f = open(self.file_path + os.path.sep +
                         "Tablestruct_" + table.Name + ".txt", "w")
                conn = client.CreateObject("ADODB.Connection")
                conn.ConnectionString = self.original_con_string
                rs = client.CreateObject("ADODB.Recordset")
                conn.Open()
                rs.Open("SELECT TOP 1 * FROM [%s];" % table.Name, conn)
                for field in rs.Fields:
                    col = table.Columns[field.Name]
                    col_details = (col.Name, col.Type, col.DefinedSize,
                                   col.Attributes)
                    property_dict = {}
                    property_dict["Autoincrement"] = (
                        col.Properties["Autoincrement"].Value)
                    col_details += property_dict,
                    f.write(repr(col_details) + "\n")
                rs.Close()
                conn.Close()
                f.close()
            if table.Type == u"LINK":
                table_details = table.Name,
                table_details += table.Properties(
                    "Jet OLEDB:Link DataSource").Value,
                table_details += table.Properties(
                    "Jet OLEDB:Link Provider String").Value,
                table_details += table.Properties(
                    "Jet OLEDB:Remote Table Name").Value,
                linked_tables += table_details,
        if linked_tables != ():
            f = open(self.file_path + os.path.sep +
                     "linked_list.txt", "w")
            for t in linked_tables:
                f.write(repr(t) + "\n")
        cat.ActiveConnection.Close()

类似的反向函数使用第二个连接字符串重建数据库。

【讨论】:

  • 没有“Access SQL”之类的东西。 Access 默认使用 Jet SQL,但这完全独立于 Access。
  • @mavnn:是的,真丢脸。 每个人都知道你的意思这一事实与此事无关:)
  • @David W. Fenton:Access 数据引擎(简称 ACE)使用的 SQL 语法怎么样?这可以在诸如 SO 之类的友好问答网站上被非正式地称为“访问 SQL”,你不觉得吗? :)
  • 更正:忘记非正式的,看起来它现在是 Access2007 时代的官方。请参阅:msdn.microsoft.com/en-us/library/bb245488.aspx——它是 MSDB 的完整部分,标题为“Microsoft Access SQL 参考”。我看不到一个提到“Jet”的地方:)
  • 只是为了保持参考最新,这里是 Microsoft Access SQL 参考的链接。无论如何,就目前而言。 msdn.microsoft.com/en-us/library/bb259125%28v=office.12%29.aspx
【解决方案5】:

您可以使用 ACE/Jet OLE DB Provider 和 ADO Connection 对象的 OpenSchema 方法来获取作为 Recordset 的架构信息(这可以说比 Collection 更好,因为它可以进行过滤、排序等)。

基本方法是使用 adSchemaTables 获取基表(而不是 VIEW),然后使用每个 TABLE_NAME 获取 ORDINAL_POSITION、!DATA_TYPE、!IS_NULLABLE、!COLUMN_HASDEFAULT、!COLUMN_DEFAULT、!CHARACTER_MAXIMUM_LENGTH、!NUMERIC_PRECISION、!NUMERIC_SCALE 的 adSchemaColumns .

adSchemaPrimaryKeys 很简单。 adSchemaIndexes 是您可以找到 UNIQUE 约束的地方,不确定这些是否可以与唯一索引区分开来,以及插入 adSchemaForeignKeys 行集的外键名称,例如(伪代码):

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

--注意 Jet 3.51 允许基于无名 PK 的 FK (!!)

验证规则和检查约束的名称可以在 adSchemaTableConstraints 行集中找到,使用 OpenSchema 调用中的表名,然后使用对 adSchemaCheckConstraints 行集的调用中的名称,过滤 CONSTRAINT_TYPE = 'CHECK'(一个陷阱是一个名为 'ValidationRule' + Chr$(0) 的约束,因此最好从名称中转义空字符)。请记住,ACE/Jet 验证规则可以是行级或表级(CHECK 约束始终是表级),因此您可能需要在过滤器中使用表名:对于 adSchemaTableConstraints 是 [].[].ValidationRule将是 adSchemaCheckConstraints 中的 [].ValidationRule。另一个问题(疑似错误)是字段的宽度为 255 个字符,因此任何超过 255 个字符的验证规则/检查约束定义都将具有 NULL 值。

adSchemaViews,用于基于非参数化 SELECT SQL DML 的 Access Query 对象,非常简单;您可以使用 adSchemaColumns 中的 VIEW 名称来获取列详细信息。

PROCEDURES 在 adSchemaProcedures 中,是所有其他类型的 Access Query 对象,包括参数化的 SELECT DML;对于后者,我更喜欢用 PROCEDURE_DEFINITION 中的 CREATE PROCEDURE PROCEDURE_NAME 替换 PARAMETERS 语法。不要打扰查看 adSchemaProcedureParameters,您不会找到任何东西:可以通过使用 ADOX 目录对象来枚举参数以返回 ADO 命令,例如(伪代码):

Set Command = Catalog.Procedures(PROCEDURE_NAME).Command

然后为 .Name 枚举 Comm.Parameters 集合,为 DATA_TYPE 枚举 .Type,为 IS_NULLABLE 枚举 (.Attributes And adParamNullable),为 COLUMN_HASDEFAULT 和 COLUMN_DEFAULT 枚举 .Value,.Size、.Precision、.NumericScale。

对于 ACE/Jet 特定的属性,例如 Unicode 压缩,您需要使用另一种对象。例如,可以使用 ADO 目录对象找到 Access-speak 中的长整数自动编号,例如(伪代码):

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

祝你好运:)

【讨论】:

    【解决方案6】:

    查看 docmd.TransferDatabase 命令。对于需要复制数据结构的构建集成,这可能是您的最佳选择

    【讨论】:

      【解决方案7】:

      比较他们 http://home.gci.net/~mike-noel/CompareEM-LITE/CompareEM.htm 将愉快地生成重新创建 MDB 所需的 VBA 代码。或者创建两个 MDB 之间差异的代码,以便您可以对现有的 BE MDB 进行版本升级。这有点古怪,但有效。注意它不支持新的 ACE (Access2007) ACCDB 等格式。

      我一直在使用它。

      (OneDayWhen 的编辑是正确的三分之一,错误的三分之二。)

      【讨论】:

        【解决方案8】:

        在 Access 中很难执行 DDL 脚本/查询。它可以完成,但你最好只创建数据库的副本 - 删除所有数据并压缩它。然后使用它的副本在其他地方重新创建数据库。

        【讨论】:

        • 我担心这可能是答案。所以构建集成是毫无疑问的。
        • 但这不是你的问题。您没有询问构建集成,而是询问了提取模式。您当然可以通过编写代码来编写架构构建过程的脚本,就像您的应用程序的其余部分一样。
        【解决方案9】:

        非常有用的帖子!

        我已修改脚本以生成 SQL Server 的数据定义语言。我认为它可能对某人有用,所以我分享它。我遇到的一个问题是 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
        

        【讨论】:

          【解决方案10】:

          Roland 的上述回答(由 Tobias 编辑)对我有用,但有一些变化。首先我解决了在主键中查找所有字段的问题;那么索引sql代码的写入文件是在错误的地方: 选项比较数据库

          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 = ""
          
                              '''  use the ndx collection rather than tdf
                              For Each fld In ndx.Fields
                                  strFlds = strFlds & ",[" & fld.Name & "] ASC "
                                  Exit For
                              Next
          
                              strSQL = strSQL & Mid(strFlds, 2) & ") "
                          End If
                          ''' write to file for each iteration of the loop to get multiple indexes
                          f.WriteLine strSQL & vbCrLf
                      Next
                  End If
              Next
          
              f.Close
          
          End Function
          

          【讨论】:

            猜你喜欢
            • 2012-06-09
            • 2016-10-09
            • 1970-01-01
            • 1970-01-01
            • 2017-03-15
            • 2013-10-20
            • 1970-01-01
            相关资源
            最近更新 更多