各位大哥们:本人想在VB中用代码创建一个ACCESS数据库,就是在窗体上放置一些按钮和文本框,通过输入数据库名、表名、字段名来创建数据库。请大家告诉小弟怎么用代码实现!~~~~~不胜感激~~~

解决方案 »

  1.   

    其实就是T-SQL语句,楼主为何不用ACCESS来创建呢
      

  2.   

    http://www.chenoe.com/blog/article.asp?id=1910
    使用ADOX动态创建数据库,表,字段.暂时还没有写完整,但此部份己能正常使用。
    TCreateDataBase.cls''''欢迎你下载使用本代码,本份代码由程序太平洋提供下载学习之用
    ''''声明:
    ''''1.本站所有代码的版权归原作者所有,如果你使用了在本站下载的源代码
    '''' 引起的一切纠纷(后果)与本站无关,请您尊重原作者的劳动成果!
    ''''2.若本站在代码上有侵权之处请您与站长联系,站长会及时更正。
    ''''论坛:http://www.5ivb.net
    ''''Email:[email protected]
    ''''CopyRight 2001-2005 By dapha.net
    ''''整理时间:2004-7-31 22:10:30Option Explicit
    Public Enum DataBaseVer
    ACCESS97 = 1
    ACCESS2000 = 2
    End Enum
    Private obj_Cat As ADOX.Catalog
    Private obj_table As ADOX.Table
    Dim obj_col As Column
    Private m_DBName As String ''''数据库名称
    Private m_DBVer As DataBaseVer ''''数据库版本
    Private strConnection As String ''''数据库连接驱动
    Public Property Let DataBaseName(ByVal value As String)
    m_DBName = value
    End Property
    Public Property Let SetDataBaseVer(ByVal value As DataBaseVer)
    m_DBVer = value
    End Property
    Public Function CreateDataBase(Optional DataBaseName As String = "", Optional p_DBVer As DataBaseVer, Optional OverWrite As Boolean = False) As Boolean
    ''''DataBaseName 数据库名称
    ''''数据库版本 1.ACCESS97 2.ACCESS2000
    ''''OverWrite 是否重写原有的数据库 False 不需要 True 需要
    On Error GoTo errorhand
    If p_DBVer > 0 Then m_DBVer = p_DBVer
    If Len(Trim(DataBaseName)) > 0 Then m_DBName = DataBaseName
    Select Case m_DBVer
    Case 1
    strConnection = GetDBConnection
    Case 2
    strConnection = GetDBConnection(True)
    Case Else
    Err.Raise 30001, "TCreateDataBase", "数据库选择参数未选"
    End Select
    If Len(Trim(m_DBName)) = 0 Then
    Err.Raise 30002, "TCreateDataBase", "文件名错误---空的文件名"
    End If
    obj_Cat.Create strConnection
    CreateDataBase = True
    Exit Function
    errorhand:
    If OverWrite Then
    Kill m_DBName
    Resume ''''返回错误发生处
    Else
    Err.Raise 30006, "TCreateDataBase", "数据库己存在"
    End If
    CreateDataBase = False
    End Function
    Public Function CrateTable(ByVal TableName As String, Optional OverWrite As Boolean = False)
    On Error GoTo errhand:
    If obj_Cat Is Nothing Then
    Err.Raise 30003, "TCreateDataBase----CreateTable", "对象不存在"
    Exit Function
    End If
    Set obj_table = New Table
    obj_table.Name = TableName
    obj_Cat.Tables.Append obj_tableExit Function
    errhand:End Function
    Private Function GetDBConnection(Optional ByVal value As Boolean = False) As String
    If value Then
    GetDBConnection = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
    "Data Source=" & m_DBName & ";"
    Else
    GetDBConnection = "Provider=Microsoft.Jet.OLEDB.3.51;" & _
    "Data Source=" & m_DBName & ";"
    End If
    End Function
    Private Sub Class_Initialize()
    Set obj_Cat = New ADOX.CatalogEnd Sub
    Public Function CreateColumn(ByVal ColName As String, ByVal pType As DataTypeEnum, _
    Optional ByVal Size As Integer = 255, Optional ByVal AutoInc As Integer = 0, _
    Optional ByVal Nullable As Integer = 0, _
    Optional ByVal Defaultvalue As Variant = vbEmpty) As Boolean
    ''''ColName 列名
    ''''pType 数据类型
    ''''Size 类型大小
    ''''AutoInc 如果是int型,是否设置为自动增长
    ''''Nullable是否允许为空 0,默认(必填项) 1 允许为空
    ''''Defaultvalue 默认值 由于时间原因,只能这样应付着了 需要和类型配合否则有可能出错
    ''''如:.CreateColumn "Age", adInteger, , , , 4 Integer型,默认值 4
    '''' .CreateColumn "UserName", adVarWChar, 20, , , "wangfeng" 文本型,默认值 wangfeng
    On Error GoTo CreateColumn_Error
    Set obj_col = New ADOX.Column
    With obj_col
    .Name = ColName
    .Type = pType
    If .Type >= adVarChar Then .DefinedSize = Size
    Set .ParentCatalog = obj_Cat
    If .Type = adInteger Then .Properties("Autoincrement") = (AutoInc = 1)
    .Properties("Nullable") = (Nullable = 1)
    If Defaultvalue <> vbEmpty Then
    .Properties("Default").value = Defaultvalue
    End If
    End With
    obj_table.Columns.Append obj_col
    CreateColumn = True
    Exit Function
    CreateColumn_Error:
    CreateColumn = False
    '''' Err.Raise 30004, "TCreateDataBase----CreateColumn", "未知错误"
    End Function
    Private Sub Class_Terminate()
    Set obj_col = Nothing
    Set obj_table = Nothing
    Set obj_Cat = Nothing
    End Sub
    使用此类,需要引ADOX对象示例:
    '欢迎你下载使用本代码,本份代码由程序太平洋提供下载学习之用
    '声明:
    '1.本站所有代码的版权归原作者所有,如果你使用了在本站下载的源代码
    ' 引起的一切纠纷(后果)与本站无关,请您尊重原作者的劳动成果!
    '2.若本站在代码上有侵权之处请您与站长联系,站长会及时更正。
    '论坛:http://www.5ivb.net
    'Email:[email protected]
    'CopyRight 2001-2005 By dapha.net
    '整理时间:2004-7-31 22:10:30Option Explicit
    Private Sub Command1_Click()
    On Error GoTo errhand
    Dim i As Integer, j As Integer
    Dim obj_Create As TCreateDataBase
    Set obj_Create = New TCreateDataBase
    With obj_Create
    .DataBaseName = "c:\wf.mdb"
    .SetDataBaseVer = ACCESS2000
    .CreateDataBase , , True '参数三 是否覆盖
    .CrateTable "UserInfo"
    .CreateColumn "ID", adInteger, , 1 '自动增长
    .CreateColumn "UserName", adVarWChar, 20, , , "wangfeng" '长度为20
    .CreateColumn "Age", adInteger, , , , 24
    .CreateColumn "Address", adVarWChar, , , 1 '必填 否
    For i = 1 To 10
    .CrateTable "Test" & CStr(i)
    For j = 1 To 10
    .CreateColumn "Test" & CStr(j), adInteger
    Next
    Next
    End With
    Set obj_Create = Nothing
    MsgBox "数据库建立成功!", vbInformation, "提示"
    Exit Sub
    errhand:
    MsgBox Err.Description
    End Sub