笔者在工作中，经常使用 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

如图所示结果显示正常：

VBA 连接 Excel查询结果

不知道为什么，非常无奈，请哪位知道的高手朋友帮忙看看问题出在哪里？