mysql二维数组vb_VBA链接MYSQL的帮助类

本类模块是用于excel的VBA链接MYSQL的帮助类

在使用该类模块前请先安装mysql 8.0 数据库驱动

MySQL 8.0: Connector/ODBC

类模块代码

Dim strcn As String

Dim cn As New ADODB.Connection

'构造函数

Private Sub Class_Initialize()

On Error Resume Next

strcn = "Driver=MySQL ODBC 8.0 Unicode Driver" & _

";Server=127.0.0.1" & _

";Database=test" & _

";Uid=root" & _

";Pwd=pwd" & _

";Option=3306" & _

";Stmt=Set Names Utf-8"

cn.Open strcn

cn.CursorLocation = adUseClient

If err <> 0 Then

MsgBox "连接数据库失败!" & vbCrLf & "错误信息" & err.Number & ":" & err.Description

err.Clear '清除错误

Exit Sub

End If

End Sub

'析构函数

Private Sub Class_Terminate()

cn.Close

End Sub

'执行sql语句，返回行数

Public Function ExecCmd(ByVal strSql As String) As Long

On Error GoTo er

Dim N As Long

cn.Execute strSql, N

ExecCmd = N

Exit Function

er:

ExecCmd = 0

MsgBox "错误在 [ExecCmd] ! " & vbCrLf & "错误信息:" & err.Number & ":" & err.Description, "执行失败"

End Function

'执行sql语句，返回Recordset

Public Function ExecRecordset(ByVal strSql As String) As ADODB.Recordset

On Error GoTo er

Dim rd As Recordset

Set rd = cn.Execute(strSql)

Set ExecRecordset = rd

Exit Function

er:

Set ExecRecordset = Nothing

MsgBox "错误在 [ExecRecordset] ! " & vbCrLf & "错误信息:" & err.Number & ":" & err.Description, "数据获取失败"

End Function

'一次性读取所有数据

Public Sub get_alldata(ByVal rng As Range, ByVal rs As ADODB.Recordset)

On Error GoTo er

rng.CopyFromRecordset rs

Exit Sub

er:

MsgBox "错误在 [get_alldata] ! " & vbCrLf & "错误信息:" & err.Number & ":" & err.Description, "数据读取失败"

End Sub

''记录集转二维数组

Public Function get_resarr(ByVal res As ADODB.Recordset) As Variant

On Error GoTo er

Dim arr() As Variant, act As Integer, bct As Integer

act = res.RecordCount - 1: bct = res.Fields.Count - 1

ReDim arr(act, bct)

Dim j As Integer, i As Integer

Do While Not res.EOF

For i = 0 To res.Fields.Count - 1 Step 0

ReDim Preserve arr(act, bct)

arr(j, i) = res.Fields(i).Value

i = i + 1

Next

j = j + 1

res.MoveNext

Loop

get_resarr = arr

Exit Function

er:

get_resarr = Nothing

MsgBox "错误在 [get_resarr] ! " & vbCrLf & "错误信息:" & err.Number & ":" & err.Description, "转二维数组失败"

End Function