vb获取、创建数据库及包含表和字段名

Option Explicit
Dim isConnect As Boolean '判断数据库是否连接成功
Dim ConADODB As New ADODB.Connection '用于连接MASTER系统数据库
Dim ResADODB As New ADODB.Recordset '用于获取所有数据库
'Dim ConADODB As New ADODB.Connection '用于连接用户数据库
Private Sub CboChooseDatabase_Click() '选择数据库，得到该数据库所有的表(只操作用户表）
    Dim rs As New ADODB.Recordset
    Call ConnectDatabase(CboChooseDatabase.Text, ConADODB)
    CboTable.Clear
    Dim criteria(3) As Variant
    criteria(0) = CboChooseDatabase.Text
    criteria(1) = Empty
    criteria(2) = Empty
    criteria(3) = "table"
    Set rs = ConADODB.OpenSchema(adSchemaTables, criteria)
    While Not rs.EOF
        CboTable.AddItem (rs!TABLE_NAME)
        rs.MoveNext
    Wend
    CboTable.Text = CboTable.List(0)
    Call CboTable_Click
    Dim i As Integer
    rs.Close
    ConADODB.Close
End Sub
Private Sub CboTable_Click() '选择表，得到表中所有字段名称
    Dim strSql As String
    Dim rs As New ADODB.Recordset
    Call ConnectDatabase(CboChooseDatabase.Text, ConADODB)
    strSql = " Select Name FROM SysColumns Where id=Object_Id('" & CboTable.Text & "')"
    rs.Open strSql, ConADODB
    CboTableField.Clear
    Do While Not rs.EOF
        CboTableField.AddItem rs!Name
        rs.MoveNext
    Loop
    CboTableField.Text = CboTableField.List(0)
    rs.Close
    ConADODB.Close
End Sub
Private Sub CboTableField_Click()
    TxtFieldName.Text = CboTableField.Text
End Sub

Private Sub CmdAlterDatabaseName_Click() '修改数据库名称
    Dim strOldName As String
    Dim strNewName As String
    Dim strSql As String
    strOldName = CboChooseDatabase.List(CbxIndex)
    strNewName = CboChooseDatabase.Text
    strSql = "Exec sp_renamedb '" & strOldName & "','" & strNewName & "' "
    Call ConnectSting
    ConADODB.Execute strSql
    ConADODB.Close
End Sub
Private Sub CmdAlterTable_Click() '修改表的名称，该表必须存在
    Dim strOldName As String
    Dim strNewName As String
    Dim strSql As String
    strOldName = CboChooseDatabase.List(CbxIndex)
    strNewName = CboChooseDatabase.Text
    strSql = "Exec sp_renamedb '" & strOldName & "','" & strNewName & "' "
    ConADODB.Execute strSql
End Sub

'创建一个新的数据库
Private Sub CmdCreateDatabase_Click()
    Dim strNewDatabaseName As String
    Dim strSql As String
    Dim i As Integer
    strNewDatabaseName = CboChooseDatabase.Text
    For i = 0 To CboChooseDatabase.ListCount - 1
        If CboChooseDatabase.List(i) = strNewDatabaseName Then
            MsgBox "该数据库已经存在，请重新命名数据库！"
            Exit Sub
        End If
    Next i
    If Len(Trim(CboChooseDatabase.Text)) > 0 Then
        CboChooseDatabase.AddItem (strNewDatabaseName)
        Dim strNameData, strFileNameDataMdf As String
        Dim strNameLog, strFileNameLogLdf As String
        strNameData = strNewDatabaseName & "_data"
        strFileNameDataMdf = "D:\" & strNameData & ".mdf"
        strNameLog = strNewDatabaseName & "_log"
        strFileNameLogLdf = "D:\" & strNameLog & ".ldf"
        strSql = "create database " & strNewDatabaseName & " on primary(name=" & strNameData & ",filename='" & strFileNameDataMdf & "'"
        strSql = strSql & ",size=5mb,maxsize=100mb,filegrowth=10%)log on(name=" & strNameLog & ",filename='" & strFileNameLogLdf & "',size=5mb,maxsize"
        strSql = strSql & "=100mb,filegrowth=10%)"
        Call ConnectSting
        ConADODB.Execute strSql
        MsgBox "数据库创建成功！"
    Else
        MsgBox "数据库名称不能为空，请命名！"
    End If
    ConADODB.Close
End Sub

Private Sub CmdDelDatabase_Click() '删除数据库，不能删除系统数据库
    Dim strDataName As String
'    Dim ConADODB As New ADODB.Connection
'    On Error GoTo err
'        ConADODB.State
    strDataName = CboChooseDatabase.Text
    Dim strSql As String
    If strDataName <> "master" And strDataName <> "model" And strDataName <> "msdb" And strDataName <> "tempdb" And Mid(strDataName, 1, 13) <> "ReportServer$" Then
        strSql = "drop database " & strDataName & ""
        Call ConnectSting
        ConADODB.Execute strSql
        CboChooseDatabase.Clear
        Call InitDB
    Else
        MsgBox "不能删除系统数据库！"
        Exit Sub
    End If
'err:
'    MsgBox err.Description
ConADODB.Close
End Sub

Private Sub CmdDelTable_Click() '删除数据库中的一张表
    Dim strDataName As String '待删除表所在的数据库
    Dim strTableName As String '待删除的表名
    Dim strSql As String
    strDataName = CboChooseDatabase.Text
    strTableName = CboTable.Text
    If Trim(strDataName) = "" Then
        MsgBox "没有选择数据库，请选择！"
        Exit Sub
    End If
    If Trim(strTableName) = "" Then
        MsgBox "没有选择表，请选择！"
        Exit Sub
    End If
    Call ConnectDatabase(strDataName, ConADODB)
    strSql = "if exists (select 1 from sysobjects where id=object_id('" & strTableName & "')and type='U')drop table " & strTableName & ""
    If isConnect = False Then
        MsgBox "没有连接成功数据库，请重新选择数据库！"
        Exit Sub
    Else
        ConADODB.Execute strSql
    End If
    ConADODB.Close
End Sub
Private Sub InitDB()
    Call ConnectSting
    ConADODB.CommandTimeout = 20
    '获取本地sql服务器中所有数据库
    ResADODB.Open "sysdatabases", ConADODB, adOpenDynamic, adLockOptimistic
    Dim strDataName As String
    Do While Not ResADODB.EOF
        strDataName = ResADODB.Fields("name").Value
        If strDataName <> "master" And strDataName <> "model" And strDataName <> "msdb" And strDataName <> "tempdb" And Mid(strDataName, 1, 13) <> "ReportServer$" Then
            CboChooseDatabase.AddItem (strDataName)
        End If
        ResADODB.MoveNext
    Loop
    Set ResADODB = Nothing
    ConADODB.Close
End Sub
Private Sub Form_Load()
    LvwNewTable.Enabled = False
    LvwNewTable.BackColor = &H8000000B
    Call InitDB
End Sub
Private Sub ConnectDatabase(databaseName As String, cn As ADODB.Connection) '为数据库创建连接对象并返回
    Dim i As Integer
    For i = 0 To CboChooseDatabase.ListCount
        If Trim(CboChooseDatabase.List(i)) = Trim(databaseName) Then
            cn.ConnectionString = "Provider=SQLOLEDB;Persist Security Info=False;User ID=sa;PWD=密码;Initial Catalog=" & databaseName & ";Data Source=服务器名" '连接数据库字符串
            cn.Open
            isConnect = True
            Exit Sub
        End If
    Next i
    isConnect = False
    MsgBox "选择的数据库不存在，请重新创建或选择！"
End Sub

Private Sub ConnectSting()
    If ConADODB.State = 0 Then
        ConADODB.ConnectionString = "Provider=SQLOLEDB;Persist Security Info=False;User ID=sa;PWD=密码;Initial Catalog=master;Data Source=服务器名" '连接数据库字符串
        ConADODB.Open
End If
End Sub

 代码还是有点问题，以后改正！有兴趣的朋友可以参考下.........................