Excel VBA 连接 MySQL 数据库遇到的“巨坑”

笔者在工作中，经常使用 Excel VBA查询和汇总数据，非常方便，但最近遇到个麻烦，怎么也解决不了，今天整理出来还请高手帮忙指导。

一、原始数据

数据库名称：corn

表：成品出库

查询代码：

SELECT date , sht_id , customer, product , 小袋规格 , 大袋规格 FROM `成品出库`
where customer = '何现锋' and product = '达育5158'

查询结果如下图（经核对与原始数据一致）：

查询结果

二、Excel VBA 连接MySQL数据库

连接代码：

Option Explicit
Sub GetDataFromMysql()

Dim con As New ADODB.Connection
Dim rs As New ADODB.Recordset

Dim sql As String, customer_name$
Dim sh As Worksheet
Dim i As Integer

Set sh = Sheets(2)
sh.Range("A1:L500").Clear

'连接数据库
con.ConnectionString = "driver={MySQL ODBC 8.0 unicode Driver};server=localhost;uid=wyj;pwd=wyj;database=corn;port=3306;"
con.Open

customer_name = Sheets(2).Range("M2").Value

sql = "select date,customer,address,product,小袋规格,大袋规格 from 成品出库 where customer like '%" & customer_name & "%' "

rs.Open sql, con, adOpenStatic, adLockOptimistic

'设置表头
'sh.Range("A1:E1").Value = Array("ID", "date", "name", "salary", "other")

For i = 0 To rs.Fields.Count - 1

sh.Cells(1, i + 1) = rs.Fields(i).name

Next i

'输出结果
sh.Range("A2").CopyFromRecordset rs

'关闭连接，释放内存

rs.Close
con.Close
Set rs = Nothing
Set con = Nothing

End Sub

运行代码后查询结果：

“巨坑”来了，大家注意看product列中品种名称达育5158，只显示：达育51。丢失了部分数据。

连接数据库查询结果

三、VBA连接EXCEL检查查询结果

代码：

Option Explicit
Sub QueryFromExcel()
Dim Conn As Object, Rst As Object
Dim strConn As String, strSQL As String
Dim i As Integer, Path As String
Dim customer_name As String

Set Conn = CreateObject("ADODB.Connection")
Set Rst = CreateObject("ADODB.Recordset")

Path = "E:/public/历年报表/玉米报表2022.7.13.xls"

Select Case Application.Version * 1
Case Is <= 11
strConn = "Provider=Microsoft.Jet.Oledb.4.0;Extended Properties=excel 8.0;Data source=" & Path
Case Is >= 12
strConn = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & Path & ";Extended Properties=""Excel 12.0 ; HDR =YES"";"
End Select

'设置SQL查询语句
customer_name = Sheets(2).Range("M2").Value

strSQL = "SELECT date,customer,address,product,小袋规格,大袋规格 FROM [成品出库$] where customer like '%" & customer_name & "%'" _
& "or address like '%" & customer_name & "%'or product like '%" & customer_name & "%'or description like '%" & customer_name & "%' "

Conn.Open strConn '打开数据库链接

Set Rst = Conn.Execute(strSQL) '执行查询，并将结果输出到记录集对象

With Sheet2
.Range("A1:L1000").Clear
For i = 0 To Rst.Fields.Count - 1 '填写标题
.Cells(1, i + 1) = Rst.Fields(i).name
Next i
.Range("A2").CopyFromRecordset Rst

End With

Rst.Close '关闭数据库连接
Conn.Close
Set Conn = Nothing
Set Rst = Nothing

End Sub