一、VBA连接MySql前的准备

    Tools--->References..---->引用

    勾选Microsoft ActiveX Data Objects 2.8 Librarys 
    和Microsoft ActiveX Data Objects Recordset 2.8 Librarys

  如下图所示：

image

注意事项：如果没有引用这两个工程，就会出现以下报错。

image

二、安装Mysql ODBC连接服务

    下载连接：https://dev.mysql.com/downloads/connector/odbc

如下图所示，现在已经第8.0版本了，选择与Office相同架构的版本安装即可。

image

三、 添加ODBC数据源

安装完上面提到的驱动以后，就可以向 Windows 中添加 ODBC 数据源了。

image

选择ODBC数据源64位的。

image

image

image

其中的TCP/IP server也可以填localhost.

四、先尝试下Excel通过ODBC连接到Mysql。

image

image

image

image

这是Excel连接数据库的一种方式，还有一种方式在下篇文章讲到，这里就先讲用ODBC数据源。

五、VBA 通过ADO连接Mysql

在前面已经在VBA 中添加好了引用，接下来就开始连接写代码连接mysql了。

Public x As ADODB.Connection
Sub DB_CONNECT()  '通过ADO连接数据库
If x Is Nothing Then
  Set x = CreateObject("adodb.connection")
  x.Open "MySQL", "root", "123456"      'MySQL是在ODBC中Data source Name ;root是用户名 123456 是密码
ElseIf x.State = 0 Then
  Set x = CreateObject("adodb.connection")
  x.Open "MySQL", "root", "123456"
End If
End Sub

上面一个过程是用来连接Mysql，比较简单的几句话。

Function Data_ExtractSQL(S_sql As Variant, Optional headers As Boolean = True)
'输入S_SQL,返回SQL查询结果
    Set x = CreateObject("adodb.connection")
  x.Open "MySQL", "root", "123456"
  Set yy = x.Execute(S_sql)
  Data_ExtractSQL = ExtractSQL(yy, headers)
End Function

自定义函数Data_ExtractSQL(s_sql,false or true)

Function ExtractSQL(ByVal sql As Recordset, Optional headers As Boolean = True)
  On Error Resume Next
  FieldsCount = sql.fields.Count
  Dim temp() As Variant
  Dim arr() As Variant
  If sql.EOF = False Then
      temp = sql.GetRows
  Else
      ReDim temp(FieldsCount - 1, 1)
  End If
  m = Application.Caller.Rows.Count
  n = UBound(temp, 2)
  ReDim arr(Application.WorksheetFunction.Max(m, n + 200), FieldsCount - 1)
  If headers Then
      record_num = 1
  Else
      record_num = 0
  End If
  Do While record_num + headers <= n
      For i = 0 To FieldsCount - 1
      If headers And record_num = 1 Then
        FieldName = sql.fields(i).Name  '加列名
          arr(0, i) = FieldName
          'ExtractSQL(0, i) = FieldName
      End If
      If IsNull(temp(i, record_num + headers)) Then
          arr(record_num, i) = ""
      Else
          arr(record_num, i) = temp(i, record_num + headers)
      End If
  Next
  record_num = record_num + 1
  Loop
  ExtractSQL = arr
End Function

上面这个函数才是整个取数据的关键，将sql取出来的数据放入一个字典当中。
以上代码只要改第一个过程中的数据库名，用户名和密码。在excel中输入公式后同时按下Ctrl+shift+Enter 数组键。

实例.png

也可以用再用VBA编写一个 将数组公式展示出来的过程。

Sub DisplayArray()  
Adress = Selection.Address(rowabsolute:=False, columnabsolute:=False) & ":"
On Error Resume Next
Adress = Selection.CurrentArray.Address(rowabsolute:=False, columnabsolute:=False) & ":"
Range(Left(Adress, Application.Find(":", Adress) - 1)).Select
Formula = Selection.Formula
arr = Evaluate(Formula)
RowN = UBound(arr, 1) - 1
ColumnN = UBound(arr, 2) - 1

If Application.WorksheetFunction.CountA(ActiveSheet.Range(Selection, Selection.Offset(RowN, ColumnN))) > 1 Then
    i = 0
   j = 0
    For i = 0 To RowN
        If Selection.Offset(i, 0).Value <> arr(i + 1, 1) And Selection.Offset(i, 0) <> Empty Then
           GoTo ending
        End If
        For j = 0 To ColumnN
            If Selection.Offset(i, j).Value <> arr(i + 1, j + 1) And Selection.Offset(i, j) <> Empty Then
               j = j - 1
               ColumnN = j
               GoTo nextrow
            End If
        Next
nextrow:
    Next
Else
    i = RowN + 1
    j = ColumnN + 1
End If
ending:
i = Application.WorksheetFunction.Max(i - 1, 0)
j = Application.WorksheetFunction.Max(j - 1, 0)
Range(Selection, Selection.Offset(i, j)).FormulaArray = Formula
End Sub

最后可以将这些过程封装成插件按钮的形式放在控制栏，如下：

插件.png

以上代码欢迎各位尝试一起优化。