vb 读取mysql所有表名_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 & "',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,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

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

总结

如果觉得编程之家网站内容还不错，欢迎将编程之家网站推荐给程序员好友。

本图文内容来源于网友网络收集整理提供，作为学习参考使用，版权属于原作者。

如您喜欢交流学习经验，点击链接加入交流1群：1065694478(已满)交流2群：163560250