VBA對(duì)MySql數(shù)據(jù)庫(kù)進(jìn)行讀取和寫(xiě)入操作時(shí)間:2009-10-06 09:18:47來(lái)源:網(wǎng)絡(luò) 作者:未知 點(diǎn)擊:256次
'以下代碼用于32位系統(tǒng),Office 2003,環(huán)境,MySql版本5.1
'在使用前需要先安裝MySql的驅(qū)動(dòng)，進(jìn)行正確配置
'注意：必須給出正確的服務(wù)器名、數(shù)據(jù)庫(kù)名、表名、數(shù)據(jù)庫(kù)連接的用戶名、密碼
Option Explicit
Dim Cnn As ADODB.Con
'以下代碼用于32位系統(tǒng),Office 2003,環(huán)境,MySql版本5.1
'在使用前需要先安裝MySql的驅(qū)動(dòng)，進(jìn)行正確配置
'注意：必須給出正確的服務(wù)器名、數(shù)據(jù)庫(kù)名、表名、數(shù)據(jù)庫(kù)連接的用戶名、密碼
Option Explicit
Dim Cnn As ADODB.Connection '定義ADO連接對(duì)象
Dim Records As ADODB.Recordset '定義ADO記錄集對(duì)象
'連接到數(shù)據(jù)庫(kù)
Function CnnOpen(ByVal ServerName As String, ByVal DBName As String, ByVal TblName As String, ByVal User As String, ByVal PWD As String) '服務(wù)器名或IP、數(shù)據(jù)庫(kù)名、登錄用戶、密碼
Dim CnnStr As String '定義連接字符串
Set Cnn = CreateObject("ADODB.Connection") '創(chuàng)建ADO連接對(duì)象
Cnn.CommandTimeout = 15 '設(shè)置超時(shí)時(shí)間
CnnStr = "DRIVER={MySql ODBC 5.1 Driver};SERVER=" & ServerName & ";Database=" & DBName & ";Uid=" & User & ";Pwd=" & PWD & ";Stmt=set names GBK" '
Cnn.ConnectionString = CnnStr
Cnn.Open
End Function
'關(guān)閉連接
Function CnnClose()
If Cnn.State = 1 Then
Cnn.Close
End If
End Function
'取得記錄集
Function GetRecordset(ByVal SqlStr As String)
Set Records = CreateObject("ADODB.recordset")
Records.CursorType = adOpenStatic '設(shè)置游標(biāo)類型,否則無(wú)法獲得行數(shù)
Records.CursorLocation = adUseClient '設(shè)置游標(biāo)屬性,否則無(wú)法獲得行數(shù)
'對(duì)于Connection對(duì)象的Execute方法產(chǎn)生的記錄集對(duì)象，一般是一個(gè)只讀并且只向前的記錄集
'如果需要對(duì)記錄集進(jìn)行操作，譬如修改和增加，則需要用一個(gè)Recordset對(duì)象
'并正確設(shè)置好CursorType和LockType為適當(dāng)類型，然后調(diào)用Open方法打開(kāi)
Records.Open SqlStr, Cnn '使用這個(gè)語(yǔ)句,行數(shù)將返回-1,Set Records = Conn.Execute(SqlStr)
End Function
'寫(xiě)入Excel表
Function InputSheet(ByVal SheetName As String)
Dim Columns, Rows As Integer
Dim i, j As Integer
Columns = Records.Fields.Count
Rows = Records.RecordCount
If Records.EOF = False And Records.BOF = False Then
For i = 0 To Rows - 1
For j = 0 To Columns - 1
Sheets(SheetName).Cells(i + 2, j + 1).Select
Sheets(SheetName).Cells(i + 2, j + 1) = Records.Fields.Item(j).Value
Next
Records.MoveNext
Next
End If
Sheets(SheetName).Cells(1, 1).Select
MsgBox "Output!", vbOKOnly, "MySql to Excel"
End Function
'把Excel寫(xiě)入MySql中的數(shù)據(jù)庫(kù)
Function InsertToMySql(ByVal SheetName As String, ByVal TblName As String)
Dim SqlStr As String
Dim i, j As Integer
Dim Columns, Rows As Integer
Columns = VBAProject.func_public.GetTotalColumns(SheetName)
Rows = VBAProject.func_public.GetTotalRows(SheetName)
Set Records = CreateObject("ADODB.recordset")
'取得結(jié)果集并插入數(shù)據(jù)到數(shù)據(jù)庫(kù)
Set Records = CreateObject("ADODB.Recordset")
'以下語(yǔ)句提供了插入思路，我只是把單條記錄的插入方式改為循環(huán)，以把所有的記錄添加到表中
'rs.Open "insert into newtable values('" & ActiveSheet.Cells(i, 1).Value & "'," & "'" & ActiveSheet.Cells(i, 2).Value & "')", cnn, 0
For i = 2 To Rows
SqlStr = "INSERT INTO " & TblName & " values('" & Sheets(SheetName).Cells(i, 1).Value & "'" '注意：" values('"，字母“v”之前是有空格的！?。?br> For j = 2 To Columns
SqlStr = SqlStr & ",'" & Sheets(SheetName).Cells(i, j).Value & "'"
Next
SqlStr = SqlStr & ")"
Set Records = Cnn.Execute(SqlStr) 'rs.Open SqlStr, cnn, 0 不能用這條語(yǔ)句實(shí)現(xiàn)?。?！
Next
MsgBox "Insert!", vbOKOnly, "Excel To MySql"
End Function
'清除對(duì)象
Function ClearObj()
Set Cnn = Nothing
Set Records = Nothing
End Function
'獲得數(shù)據(jù)表的字段名稱
'OpenSchema可以獲得數(shù)據(jù)庫(kù)的各種信息
Function InputColumns(ByVal SheetName As String)
CnnOpen "localhost", "mydb", "employees", "root", ""
Set Records = Cnn.OpenSchema(adSchemaColumns)
Dim i As Integer
i = 1
While Not Records.EOF
Sheets(SheetName).Cells(1, i) = Records!COLUMN_NAME
i = i + 1
Records.MoveNext
Wend
