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