文章标题:仿照FOXPRO数据表原理，根据规范化的结构表，生成数据表

文章作者： AskHeart
发表时间： 2006-05-10 10:07:13

文章简介：
在表1中存放数据表结构，标明字段名称，字段类型，字段大小。然后根据表1生成一个符合要求的数据库表2。同FOXPRO中的要求一样。

文章正文：
'函数名称：CreateNewTable()
'功能描述：仿照FOXPRO数据表原理，根据规范化的结构表，生成数据表。
'参数调用：参数一;structtablename，命名规范化的结构表（FieldName,FieldType,FieldSize,IsSelect)
'          参数二：newtable,生成新表，字段为结构表中的fieldname记录值。
'          参数三：isSelect，为true，则选择全部记录，为false,则选择IsSelect值为真的记录。
'设计人员：AskHeart
'设计日期：2004-4-30
'适用版本：ACCESS 2000，XP
'==================================================================================================
Public Sub CreateNewTable(StructTableName As String, NewTableName As String, IsSelect As Boolean)
    Dim dbs As DAO.Database
    Dim tdf As DAO.TableDef
    Dim rst As DAO.Recordset
    Dim fld As DAO.Field
    Dim strSQL As String
    Dim m As Object
    Dim i As Integer

    Set dbs = CurrentDb
    Set tdf = dbs.CreateTableDef(NewTableName)
    If IsSelect = True Then
        strSQL = "select * from " & StructTableName
    Else
        strSQL = "select * from " & StructTableName & "where [IsSelect] = True"
    End If
    Set rst = dbs.OpenRecordset(strSQL)
    rst.MoveFirst
    Do Until rst.EOF
        Set fld = tdf.CreateField(rst("FieldCaption"), rst("Fieldtype"))
        '如果是文本型，设定字段大小，在structtablename表中的FieldSize字段值不可以为空
        If fld.Type = dbText Then
            fld.Size = rst("FieldSize")
        End If
        If fld.Type = dbDouble Then
            fld.DefaultValue = 0
        End If
        tdf.Fields.Append fld
        rst.MoveNext
    Loop
    '先判断，若有同名数据表，则先删除，再添加新表到数据库对象中。
    Set m = CurrentData
    For i = 0 To m.AllTables.Count - 1
        If m.AllTables(i).Name = NewTableName Then
            dbs.TableDefs.Delete NewTableName
        End If
    Next
    dbs.TableDefs.Append tdf
    'Set tdf = Nothing
    'Set fld = Nothing
    'Set rst = Nothing
End Sub

快捷使用步骤：
1、在EXCEL中录入数据结构表。
2、导入ACCESS中。
3、把上述代码复制到ACCESS中的模块中。
4、建立一个窗体，放入一个命令按钮，在此命令的CLICK事件中，引用过程。