如何提取Access(.mdb)数据库的架构?

时间:2009-03-30 20:10:01

标签: ms-access ms-jet-ace

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

我怎样才能实现这样的目标?

10 个答案:

答案 0 :(得分:21)

可以用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

答案 1 :(得分:10)

现在这是一个古老的问题,但遗憾的是常年:(

我认为此代码可能对其他寻求解决方案的人有用。它设计为通过cscript从命令行运行,因此无需将代码导入Access项目。与OliverHow 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 ...语法创建querydef,事实上我不确定你能不能(?)

但是这里有一段我​​编写的用于备份查询以分离.sql文件的脚本(这是用于备份所有前端db代码的更大脚本的一部分,请参阅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

答案 2 :(得分:7)

以下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找到它们,有没有人知道'正确'的方式?

答案 3 :(得分:6)

如果您乐意使用纯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()

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

答案 4 :(得分:5)

您可以使用ACE / Jet OLE DB提供程序和ADO Connection对象的OpenSchema方法将架构信息作为Recordset获取(这可以比集合更好,因为它可以被过滤,排序等)。

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

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

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

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

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

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

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

Set Command = Catalog.Procedures(PROCEDURE_NAME).Command

然后枚举.Name,.Type为DATA_TYPE的.Type,。(。属性和adParamNullable)为IS_NULLABLE,.Value为COLUMN_HASDEFAULT和COLUMN_DEFAULT,.Size,.Precision,.NumericScale。

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

bIsAutoincrement = Catalog.Tables(TABLE_NAME).Columns(COLUMN_NAME).Properties("Autoincrement").Value
祝你好运:)

答案 5 :(得分:2)

Compare'Em http://home.gci.net/~mike-noel/CompareEM-LITE/CompareEM.htm 很乐意生成需要重新创建MDB的VBA代码。或者用于创建两个MDB之间差异的代码,以便您可以对现有BE MDB进行版本升级。它有点古怪但有效。请注意,它不支持新的ACE(Access2007)ACCDB等格式。

我一直都在使用它。

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

答案 6 :(得分:1)

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

答案 7 :(得分:1)

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

答案 8 :(得分:0)

非常有用的帖子!

我修改了脚本以生成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

答案 9 :(得分:0)

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