请问怎么建立一个新的数据用程序？

建数据库及表
http://community.csdn.net/Expert/topic/4477/4477693.xml?temp=.8714716

N年前写的,用ADOX(需要引用Microsoft ADO Ext. 2.x for DDL and Security )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
Sub showtablename() '显示数据库的非系统表的表数目
On Error Resume Next
Dim mycat As New ADOX.Catalog
mycat.ActiveConnection = "Provider=MicroSoft.Jet.OLEDB.3.51;Data Source=e:\new.MDB"
msg = ""
   For i = 0 To mycat.Tables.Count - 1
   If Left(mycat.Tables.Item(i).Name, 4) <> "MSys" Then '去掉4个系统表
msg = msg & mycat.Tables.Item(i).Name & vbCrLf
End If
Next
MsgBox msg, vbOK, "数据库 e:\new.mdb  共有 " & mycat.Tables.Count - 4 & "个表！"
Set cat.ActiveConnection = Nothing
End Sub
Sub deletetable() '删除表
On Error Resume Next
Dim mycat As New ADOX.Catalog
mycat.ActiveConnection = "Provider=MicroSoft.Jet.OLEDB.3.51;Data Source=e:\new.MDB"
mycat.Tables.Delete "表" & (mycat.Tables.Count - 4)
MsgBox "删除表" & (mycat.Tables.Count - 3) & " 成功！"
Set mycat.ActiveConnection = Nothing
End SubPrivate Sub Command1_Click(Index As Integer)
Select Case Index
Case 0
creatmdb
Case 1
createtable
Case 2
showtablename
Case 3
deletetable
End SelectEnd SubPrivate Sub Form_Load()
For i = 0 To 3
Command1(i).Caption = Choose(i + 1, "创建数据库", "创建表", "显示数据库表名", "删除数据库最后的一个表")
Next
End Sub

4: 建立新的数据库和表
     前面讲到的方法有一定的局限性，它不能让用户产生自己所需的数据库文件，即使能产生数据表也只能在原有表的基础上生成。我们现在的目的就是让用户利用ADO对象在程序运行过程中创建数据库和表，就好象他利用Access来建立数据库和表一样。为此，我们应该引用对象库“Microsoft ActiveX Data Objects 2.5 Library”和“Microsoft ADO Ext 2.1. For DDL Security”
我们不妨用一个实例来说明具体的操作过程和方法。我们的实例要达到目的是：在程序运行过程中建立一个数据库，数据库的名称由用户输入。然后在数据库中建立一个名为“MyTable”的数据表，数据表中有三个字段，它们分别是：“编号”(整数型)、 “姓名”(字符型，宽度为8)、“住址” (字符型，宽度为50)，接着在数据表中添加一条记录，最后在DataGrid控件中把记录的内容显示出来，并且让用户在DataGrid控件中任意修改、添加记录。
首先在VB中新建一个窗体，然后在“工程”菜单中引用对象库“Microsoft ActiveX Data Objects 2.5 Library”和“Microsoft ADO Ext 2.1. For DDL Security”。接着定义三个窗体级的对象变量和一个窗体级的字符串变量，它们的具体定义是：
Dim cat As New ADOX.Catalog  ’不用cat用另外一个名字也可以
Dim conn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim pstr As String  ’定义该变量是为了后面的书写方便
为了更灵活地创建数据库，我们可以在窗体中加入一个通用对话框、一个DataGrid控件，三个命令按钮，它们的标题分别是：创建数据库和表、查看、更新。通用对话框的作用是给用户输入数据库文件名和决定数据库的存放位置。 “创建数据库和表”命令按钮对应的代码是：
Private Sub Command1_Click()
Dim fm As String  ‘fm变量用来获取用户输入的文件名
CommonDialog1.Filter = "MDB文件(*.mdb)|*.mdb|AllFiles(*.*)|*.*|"
CommonDialog1.FilterIndex = 1
CommonDialog1.InitDir = "D:\Jthpaper"
CommonDialog1.Flags = 6
CommonDialog1.Action = 2
If CommonDialog1.FileName = "" Then
MsgBox "你必须输入一个文件名，请重新保存一次！"
Exit Sub
Else
fm = CommonDialog1.FileName
End If
pstr = "Provider=Microsoft.Jet.OLEDB.4.0;"   ’不能把这里的4.0改为3.51
pstr = pstr & "Data Source=" & fm
cat.Create pstr  ‘创建数据库
Dim tbl As New Table
cat.ActiveConnection = pstr
   tbl.Name = "MyTable"  ‘表的名称
   tbl.Columns.Append "编号", adInteger    ‘表的第一个字段
   tbl.Columns.Append "姓名", adVarWChar, 8  ‘表的第二个字段
   tbl.Columns.Append "住址", adVarWChar, 50  ‘表的第三个字段
   cat.Tables.Append tbl    ‘建立数据表
conn.Open pstr
rs.CursorLocation = adUseClient
rs.Open "MyTable", conn, adOpenKeyset, adLockPessimistic
rs.AddNew    ‘往表中添加新记录
rs.Fields(0).Value = 9801
rs.Fields(1).Value = "孙悟空"
rs.Fields(2).Value = "广州市花果山"
rs.Update
End Sub
   上面程序中有一个需要说明的地方，这就是语句：pstr = "Provider=Microsoft.Jet.OLEDB.4.0;"，这个语句表示Microsoft Jet OLEDB驱动程序的版本是4.0，这是目前最新的版本，利用它你可以用VB中的ADO对象访问Access2000及其以下版本所建立的数据库。你不能把这里的“4.0”改为“3.51”，否则程序不能正常运行；在VB6中，3.51版本的Microsoft Jet OLEDB驱动程序对应的是Access97数据库。换而言之，用这种方法建立的数据库和表跟用Access2000所建立的数据库和表是同一类型的，你只能直接用Access2000来打开，虽然你可以用VB6来访问这种数据库和其中的数据表，但你不能用Access97或VB6中的“可视化数据管理器”来直接打开。
   在程序运行时只要用户单击该命令按钮就可以创建自己所需的数据库。“查看”命令按钮对应的代码是：
Private Sub Command3_Click()
Set DataGrid1.DataSource = rs
End Sub
“更新”命令按钮对应的代码是：
Private Sub Command4_Click()
rs.UpdateBatch
End Sub
我们这个实例只是用来说明问题，在实际应用当中你可以把它进一步改进，例如：你在窗体中再增加一些文本框和组合框，供用户输入或选择数据表的名称、字段的名称、字段的宽度和小数位数。这样，用户就可以自主地决定数据库的所有内容了，程序的灵活性也就大大提高了。

Public mcat        As ADOX.Catalog
Public mtbl        As ADOX.Table
Public mcol        As ADOX.Column
Public mindex      As ADOX.Index
Public mkey        As ADOX.Key
Public mcnn        As ADODB.Connection
Public ADOXstr     As StringPublic Function NewAccess(PathStr As String) As Boolean
  NewAccess = False
'  On Error GoTo Err
If Len(Dir(PathStr)) <> 0 Then Kill PathStr
    Set mcat = New ADOX.Catalog
    mcat.Create ADOXstr

'***********************************************************************************
    Set mtbl = New ADOX.Table
    mtbl.Name = "sUser"


'    Set mcol = New ADOX.Column
'    mcol.Name = "sID"
'    mcol.Type = adInteger
'    Set mcol.ParentCatalog = mcat
'    mcol.Properties("Description") = "sID"
'    mtbl.Columns.Append mcol

    Set mcol = New ADOX.Column
    mcol.Name = "sCardID"
    mcol.Type = adVarWChar
    mcol.DefinedSize = 50
    Set mcol.ParentCatalog = mcat
    mcol.Properties("Description") = "sCardID"
    mtbl.Columns.Append mcol

    Set mcol = New ADOX.Column
    mcol.Name = "sName"
    mcol.Type = adVarWChar
    mcol.DefinedSize = 50
    Set mcol.ParentCatalog = mcat
    mcol.Properties("Description") = "sName"
    mtbl.Columns.Append mcol

    Set mcol = New ADOX.Column
    mcol.Name = "sPassword"
    mcol.Type = adVarWChar
    mcol.DefinedSize = 50
    Set mcol.ParentCatalog = mcat
    mcol.Properties("Description") = "sPassword"
    mtbl.Columns.Append mcol

    Set mcol = New ADOX.Column
    mcol.Name = "sRemain"
    mcol.Type = adCurrency
    Set mcol.ParentCatalog = mcat
    mcol.Properties("Description") = "sRemain"
    mtbl.Columns.Append mcol

    Set mcol = New ADOX.Column
    mcol.Name = "sRest"
    mcol.Type = adInteger
    Set mcol.ParentCatalog = mcat
    mcol.Properties("Description") = "sRest"
    mtbl.Columns.Append mcol

    Set mcol = New ADOX.Column
    mcol.Name = "sOperator"
    mcol.Type = adVarWChar
    mcol.DefinedSize = 50
    Set mcol.ParentCatalog = mcat
    mcol.Properties("Description") = "sOperator"
    mtbl.Columns.Append mcol

    Set mcol = New ADOX.Column
    mcol.Name = "sLast"
    mcol.Type = adDate
    Set mcol.ParentCatalog = mcat
    mcol.Properties("Description") = "sLast"
    mtbl.Columns.Append mcol
        Set mindex = New ADOX.Index
    With mindex
        .Name = "PrimaryKey"
        .PrimaryKey = True
        .Unique = True
        .Columns.Append "sCardID"
    End With
    mtbl.Indexes.Append mindex
    mcat.Tables.Append mtbl

    '********************************************************************************


    Set mtbl = New ADOX.Table
    mtbl.Name = "tUser"

'
'    Set mcol = New ADOX.Column
'    mcol.Name = "tID"
'    mcol.Type = adInteger
'    Set mcol.ParentCatalog = mcat
'    mcol.Properties("Description") = "tID"
'    mtbl.Columns.Append mcol


    Set mcol = New ADOX.Column
    mcol.Name = "tCardID"
    mcol.Type = adVarWChar
    mcol.DefinedSize = 50
    Set mcol.ParentCatalog = mcat
    mcol.Properties("Description") = "tCardID"
    mtbl.Columns.Append mcol

    Set mcol = New ADOX.Column
    mcol.Name = "tAccent"
    mcol.Type = adDate
    Set mcol.ParentCatalog = mcat
    mcol.Properties("Description") = "tAccent"
    mtbl.Columns.Append mcol

    Set mcol = New ADOX.Column
    mcol.Name = "tWeek"
    mcol.Type = adVarWChar
    mcol.DefinedSize = 50
    Set mcol.ParentCatalog = mcat
    mcol.Properties("Description") = "tWeek"
    mtbl.Columns.Append mcol



    Set mcol = New ADOX.Column
    mcol.Name = "tVal"
    mcol.Type = adInteger
    Set mcol.ParentCatalog = mcat
    mcol.Properties("Description") = "tVal"
    mtbl.Columns.Append mcol

    Set mcol = New ADOX.Column
    mcol.Name = "tOver"
    mcol.Type = adCurrency
    Set mcol.ParentCatalog = mcat
    mcol.Properties("Description") = "tOver"
    mtbl.Columns.Append mcol

    Set mindex = New ADOX.Index
    With mindex
        .Name = "PrimaryKey"
        .PrimaryKey = True
        .Unique = True
        .Columns.Append "tCardID"
    End With  mtbl.Indexes.Append mindex

  Set mkey = New ADOX.Key
  mkey.Name = "IDKey"
  mkey.Type = adKeyForeign
  mkey.RelatedTable = "sUser"  Set mcol = New ADOX.Column
  mcol.Name = "tCardID"
  mcol.RelatedColumn = "sCardID"
  mkey.Columns.Append mcol
  mtbl.Keys.Append mkey
  mcat.Tables.Append mtbl
  NewAccess = True
  Exit Function

Err: End Function

调试易

请问怎么建立一个新的数据用程序？

解决方案 »