vb中如何动态的创建一个ACESSS数据库文件

Question

Public Sub CreateAPP()
    '****************************************
    '创建Application.mdb
    '****************************************
    Dim FSTest As New FileSystemObject
    Dim DaoWork As Workspace
    Dim intRetry As Integer
    Dim TAdoCn  As New Connection
    
    On Error GoTo FAIL
    '创建文件
    intRetry = 0
    Set DaoWork = DBEngine.CreateWorkspace("", "admin", "", dbUseJet)
    If FSTest.FileExists(App.Path & "\Application.mdb") = False Then
        DaoWork.CreateDatabase App.Path & "\Application.mdb", dbLangGeneral
        DaoWork.Close
        '创建表
        If TAdoCn.State <> adStateClosed Then
            TAdoCn.Close
        End If
        
        TAdoCn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Persist Security Info=False;Data Source=" & App.Path & "\Application.mdb"
        TAdoCn.Execute "CREATE  TABLE Application " & _
                "( [id]  not null, [Date] date not null,userid char(5) not null ,comid char(5) null,Letter bit not null,Proxy bit not null )"
        
        TAdoCn.Close
    End If
    
    
PROC_EXIT:
    Exit Sub ' 程序的唯一出口
FAIL:
    intRetry = intRetry + 1
    If intRetry < 3 Then Resume  ' 重试  
    MsgBox Err & vbCrLf & vbCrLf & Err.Description & vbCrLf & vbCrLf & "创建数据库失败！", vbCritical, "致命错误！"
    GoTo PROC_EXIT
End Sub

Answer 1

Sub creatmdb() '创建数据库
If Dir("e:\new.mdb") <> "" Then Kill "e:\new.mdb"
Dim mycat As New ADOX.Catalog
mycat.Create "Provider=Microsoft.Jet.OLEDB.3.51;Data Source=e:\new.mdb"
MsgBox "创建数据库 e:\new.mdb 成功！"
End Sub
Sub createtable() '创建数据库的表
On Error Resume Next
Dim mycat As New ADOX.Catalog
Dim mytable As New ADOX.Table
mycat.ActiveConnection = "Provider=MicroSoft.Jet.OLEDB.3.51;Data Source=e:\new.MDB"
 For i = 1 To 9
 mytable.Name = "表" & i
 mytable.Columns.Append "字段1", adDate
 mytable.Columns.Append "字段2", adInteger
 mytable.Columns.Append "字段3", adBoolean
 mytable.Columns.Append "字段4", adVarChar
 mycat.Tables.Append mytable
 Set mytable = Nothing
 Next
 MsgBox "创建 表1----表9 成功！"
 Set mycat.ActiveConnection = Nothing
   
End Sub