请问能在程序运行中通过代码动态创建数据库吗？

Question

我想在程序中动态的创建数据库，请问有什么方法？

Answer 1

Option Explicit
'===================================================================================
'引用：Microsoft DAO 3.51 Object Library
'===================================================================================
Private dbDataBase As DAO.Database '本模块内的数据库对象
Private tdTable As DAO.TableDef '本模块内的表对象
Private fldField As DAO.Field '本模块内的字段对象
'新建一个数据库，cDataBase(数据库的路径,数据库的密码（可选，默认空）)
Public Function cDataBase(ByVal PathFile As String, Optional ByVal Password As String = "") As Boolean
    On Error Resume Next
    Set dbDataBase = CreateDatabase(PathFile, dbLangGeneral, dbEncrypt)
    dbDataBase.NewPassword "", Password
    Set dbDataBase = Nothing
    cDataBase = (Err.Number = 0)
End Function
'新建一个表，必须有一个字段，cTable(数据库的路径,新建的表名,第一个字段名,字段的类型,字段的大小,这个数据库的密码（可选，默认空）)
Public Function cTable(ByVal MdbFile As String, ByVal TableName As String, ByVal DefaultFieldName As String, ByVal FieldType As DAO.DataTypeEnum, ByVal FieldSize As Long, Optional ByVal Password As String = "") As Boolean
    On Error Resume Next
    Set dbDataBase = DAO.OpenDatabase(MdbFile, True, False, ";pwd=" & Password & ";")
    Set tdTable = dbDataBase.CreateTableDef(TableName)
    Set fldField = tdTable.CreateField(DefaultFieldName, FieldType, FieldSize)
    tdTable.Fields.Append fldField
    dbDataBase.TableDefs.Append tdTable
    Set fldField = Nothing
    Set tdTable = Nothing
    Set dbDataBase = Nothing
    cTable = (Err.Number = 0)
End Function
'重命名一个表，ReNameTable(数据库的路径,旧的表名,新的表名,这个数据库的密码（可选，默认空）)
Public Function ReNameTable(ByVal MdbFile As String, ByVal OldTable As String, ByVal NewTable As String, Optional ByVal Password As String = "") As Boolean
    On Error Resume Next
    Set dbDataBase = DAO.OpenDatabase(MdbFile, True, False, ";pwd=" & Password & ";")
    Dim i As Long
    For i = 0 To dbDataBase.TableDefs.Count - 1
        Set tdTable = dbDataBase(i)
        If tdTable.Name = OldTable Then Exit For
        Set tdTable = Nothing
    Next
    tdTable.Name = NewTable
    ReNameTable = (Err.Number = 0)
End Function
'新建一个字段，cField(数据库的路径,表名,字段名,字段的类型,字段的大小,这个数据库的密码（可选，默认空）)
Public Function cField(ByVal MdbFile As String, ByVal TableName As String, ByVal FieldName As String, ByVal FieldType As DAO.DataTypeEnum, ByVal FieldSize As Long, Optional ByVal Password As String = "") As Boolean
    On Error Resume Next
    Set dbDataBase = DAO.OpenDatabase(MdbFile, True, False, ";pwd=" & Password & ";")
    Dim i As Long
    For i = 0 To dbDataBase.TableDefs.Count - 1
        Set tdTable = dbDataBase(i)
        If tdTable.Name = TableName Then Exit For
        Set tdTable = Nothing
    Next
    Set fldField = tdTable.CreateField(FieldName, FieldType, FieldSize)
    tdTable.Fields.Append fldField
    Set fldField = Nothing
    Set tdTable = Nothing
    Set dbDataBase = Nothing
    cField = (Err.Number = 0)
End Function
'重命名一个字段，ReNameField(数据库的路径,表名,旧的字段名,新的字段名,这个数据库的密码（可选，默认空）)
Public Function ReNameField(ByVal MdbFile As String, ByVal TableName As String, ByVal OldField As String, ByVal NewField As String, Optional ByVal Password As String = "") As Boolean
    On Error Resume Next
    Set dbDataBase = DAO.OpenDatabase(MdbFile, True, False, ";pwd=" & Password & ";")
    Set tdTable = dbDataBase.TableDefs(TableName)    Dim i As Long
    For i = 0 To tdTable.Fields.Count - 1
        Set fldField = tdTable.Fields(i)
        If fldField.Name = OldField Then Exit For
        Set fldField = Nothing
    Next
    fldField.Name = NewField
    Set fldField = Nothing
    Set tdTable = Nothing
    Set dbDataBase = Nothing
    ReNameField = (Err.Number = 0)
End Function
'删除一个表，dTable(数据库的路径,删除的表名,这个数据库的密码（可选，默认空）)
Public Function dTable(ByVal MdbFile As String, ByVal TableName As String, Optional ByVal Password As String = "") As Boolean
    On Error Resume Next
    Set dbDataBase = DAO.OpenDatabase(MdbFile, True, False, ";pwd=" & Password & ";")
    dbDataBase.TableDefs.Delete (TableName)
    Set dbDataBase = Nothing
    dTable = (Err.Number = 0)
End Function
'删除一个字段，dField(数据库的路径,表名,字段名,这个数据库的密码（可选，默认空）)
Public Function dField(ByVal MdbFile As String, ByVal TableName As String, ByVal FieldName As String, Optional ByVal Password As String = "") As Boolean
    On Error Resume Next
    Set dbDataBase = DAO.OpenDatabase(MdbFile, True, False, ";pwd=" & Password & ";")
    Dim i As Long
    For i = 0 To dbDataBase.TableDefs.Count - 1
        Set tdTable = dbDataBase(i)
        If tdTable.Name = TableName Then Exit For
        Set tdTable = Nothing
    Next
    tdTable.Fields.Delete (FieldName)
    Set tdTable = Nothing
    Set dbDataBase = Nothing
    dField = (Err.Number = 0)
End Function

Answer 2

SQL Server 2000create database bookgl on (name=book_gl,filename='c:\book_gl.mdf',maxsize=10mb,filegrowth=1mb)
log on(name=book_log,filename='c:\book_log.ldf',maxsize=5mb,filegrowth=1mb)
/创建bookgl数据库，数据库名称为book_gl，保存在c:\，最大为10mb，每次递增1mb,事务文件为book_log
保存在c:\最大为5mb，每次递增1mbuse bookgl 
create table book(book_ID int not null primary key,book_name chr(50) not null,zz_ID int not null)
/在bookgl中创建book表book_ID为int为主键不能为空,book_name为chr长度为50不能为空,zz_ID为int不能为空 use bookgl
create zz(zz_ID int not null primary key zz_name chr(50) not null,book_ID int not null foreign 
key references book(book_ID))/创建zz表zz_ID与book表book_ID关联

Answer 3

'创建临时表
Public Function create_table(rand_table As String) As BooleanOn Error GoTo ErrorHandle:    sqlstr = ""
    sqlstr = sqlstr & " create table " & rand_table
    sqlstr = sqlstr & " as"
    sqlstr = sqlstr & " select bkc_cd,child_item_cd,usage_dec,child_defect_pct,ecn_control_no,beg_eff_dte,"
    sqlstr = sqlstr & " end_eff_dte,start_ecn_accum_qty,end_ecn_accum_qty,cf_flag,master_cf_flag"
    sqlstr = sqlstr & " From temp_table"    '此处确定取出数据的表名。
    sqlstr = sqlstr & " where 1=2"    Set Cmd.ActiveConnection = adoCon
    Cmd.CommandText = sqlstr
    Set adoRecordset = Cmd.Execute
    
    create_table = True
    
Exit Function
ErrorHandle:
    Dim Er As ADODB.Error
    For Each Er In adoCon.Errors
        MsgBox Er.Description & "   " & Er.SQLState, vbOKOnly + vbCritical, "Error"
    Next Er
End Function

Answer 4

首先引用ADOX，方法为："工程"-->"引用"-->"Microsoft ADO Ext. 2.8 for DDL and Security"Dim cat As New ADOX.Catalog  不用cat用另外一个名字也可以
Dim str As String  定义该变量是为了后面的书写方便
str = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\" & strID & ".mdb;Jet OLEDB:Database Password=" & strPassword
cat.Create str  创建数据库
cat.ActiveConnection = strDim TreeView As New Table
   TreeView.Name = "TreeView"  表的名称
   TreeView.Columns.Append "路径", adVarWChar, 127   表的第一个字段
   TreeView.Columns.Append "层次数", adInteger  表的第二个字段
cat.Tables.Append TreeView    建立数据表Dim Articles As New Table
    Articles.Name = "Articles"  表的名称
    Articles.Columns.Append "标题", adVarWChar, 255 的第一个字段
    Articles.Columns.Append "正文", adLongVarWChar 表的第二个字段,为备注类型
    Articles.Columns.Append "路径", adVarWChar, 127 表的第三个字段
cat.Tables.Append Articles
Set cat = Nothing

Answer 5

http://blog.csdn.net/vbman2003/archive/2005/04/21/356897.aspx