VBA MySQL数据库连接帮助类

本篇文章分享本人常用的VBA链接MYSQL数据库通用帮助类,有需要的可以拿去

1.引用VBA相关的类库

Microsoft ActiveX Data Objects 6.1
Microsoft Scripting Runtime

2.安装MySQL驱动

mysql-connector-odbc-8.0.33-win32.msi

3.MySQL帮助类代码

Option Explicit

''数据库对象
Public mysqlCn As New ADODB.Connection

''数据库配置
Private Const Driver As String = "MySQL ODBC 8.0 Unicode Driver"  '' 驱动程序,MySQL ODBC 5.3 Unicode Driver
Private Const Host As String = "xxxxx.com"  ''数据库地址
Private Const Port As Integer = 3306  ''数据库端口
Private Const UID As String = "user" ''数据库账号
Private Const PWD As String = "password"  ''数据库密码
Private Const CharSet As String = "Utf-8" ''数据库编码


''初始化类
Private Sub Class_Initialize()
    On Error Resume Next
    Dim ConnectionString As String
    ConnectionString = "Driver=" & Driver & ";Server=" & Host & ";Database=mydb;Uid=" & UID & ";Pwd=" & PWD & ";Option=" & Port & ";Stmt=Set Names " & CharSet
    mysqlCn.Open ConnectionString
    mysqlCn.CursorLocation = adUseClient
    If Err <> 0 Then
        MsgBox "连接数据库失败!" & vbCrLf & "错误信息" & Err.Number & ":" & Err.Description
        Err.Clear '清除错误
        Exit Sub
    End If
End Sub


''析构类
Private Sub Class_Terminate()
    mysqlCn.Close
End Sub



''查询数据,并把数据转化成集合字典
Public Function QueryDatasToListDic(sql As String) As Collection
    On Error GoTo er
    Dim lst As New Collection, dic As Dictionary
    Dim rs As New ADODB.Recordset:  Set rs = mysqlCn.Execute(sql)
    ''读取数据
    rs.MoveFirst
    Do While Not rs.EOF
        Set dic = New Dictionary
        Dim field As Variant
        For Each field In rs.Fields
            dic.Add field.Name, field.Value
        Next field
        lst.Add dic
        rs.MoveNext
    Loop
    rs.Close
    Set QueryDatasToListDic = lst
    Exit Function
er:
    Debug.Print Err.Description
    Set QueryDatasToListDic = Nothing
End Function


''查询数据,并把数据转成二维数组,数据包含表头
Public Function QueryDataToArrayInHeader(sql As String) As Variant
    On Error GoTo er
    ''获取数据库数据
    Dim rs As New ADODB.Recordset
    Set rs = mysqlCn.Execute(sql)
    ' 获取表头字段名
    Dim arr() As Variant
    Dim i As Long, j As Long
    ReDim arr(0 To rs.RecordCount + 1, 0 To rs.Fields.Count)
    For j = 0 To rs.Fields.Count - 1
        arr(0, j) = rs.Fields(j).Name
    Next j
    ' 获取数据,转换成数组
    rs.MoveFirst
    i = 1
    Do While Not rs.EOF
        For j = 0 To rs.Fields.Count - 1
            arr(i, j) = rs.Fields(j).Value
        Next j
        rs.MoveNext
        i = i + 1
    Loop
    rs.Close
    ' 返回数据
    QueryDataToArrayInHeader = arr
    Exit Function
er:
    Debug.Print Err.Description
    QueryDataToArrayInHeader = Nothing
End Function

''查询数据,并把数据转成二维数组
Public Function QueryDataToArray(sql As String) As Variant
    On Error GoTo er
    ''获取数据库数据
    Dim rs As New ADODB.Recordset
    Set rs = mysqlCn.Execute(sql)
    ' 获取数据,转成数组
    Dim arr() As Variant
    Dim i As Long, j As Long
    ReDim arr(0 To rs.RecordCount, 0 To rs.Fields.Count)
    rs.MoveFirst
    i = 0
    Do While Not rs.EOF
        For j = 0 To rs.Fields.Count - 1
            arr(i, j) = rs.Fields(j).Value
        Next j
        rs.MoveNext
        i = i + 1
    Loop
    rs.Close
    ''返回数据
    QueryDataToArray = arr
    Exit Function
er:
    Debug.Print Err.Description
    QueryDataToArray = Nothing
End Function


''查询所有数据,并把数据写入指定单元格
Public Sub QueryAllDataToRange(sql As String, rng As Range)
    On Error GoTo er
    ''获取数据库数据
    Dim rs As New ADODB.Recordset
    Set rs = mysqlCn.Execute(sql)
    ''把数据写入单元格
    rng.CopyFromRecordset rs
    rs.Close
    Exit Sub
er:
    MsgBox "数据查询失败!" & vbCrLf & "错误信息" & Err.Number & ":" & Err.Description
End Sub


'' 执行SQL指令(返回受影响的行)
Public Function ExecuteSQL(sql As String) As Long
    On Error GoTo er
    Dim affectedRows As Long
    Call mysqlCn.Execute(sql, affectedRows)
    ExecuteSQL = affectedRows
    Exit Function
er:
    Debug.Print Err.Description
    ExecuteSQL = 0
End Function