笔者在上篇文章中详细介绍了Excel VBA 连接数据库时遇到的“巨坑”，非常无奈，一时无解，手足无措，奈何工作不能停，只能另辟蹊径，总算得到预期的结果，今展示给大家，以期今后少走弯路，当然仍然期待高手能够完美解决上篇文章中遇到的“巨坑”，指点迷津，答疑解惑。闲言少续，直接进主题。
一、原始文件
数据库：corn
表：成品出库
列：product
数据库中的原始数据
二、遇到“巨坑”
查询结果：product 列中的 “达育5158” 显示不全，只显示“达育51”。如图：
数据显示不全
问题代码：
Option Explicit
Sub GetDataFromMysql()
'1.设置变量
'前期绑定法
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
'2.设置查询结果存放的sheet表，这里我选择的是sheet2
Set sh = Sheets(2)
sh.Range("A1:K500").Clear
'3. 建立数据库的连接
con.ConnectionString = "driver={MySQL ODBC 8.0 unicode Driver};server=localhost;uid=wyj;pwd=wyj;database=corn;port=3306;option=3"
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
'4.设置表头
'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
'5.将数据输出到sheet2工作表
sh.Range("A2").CopyFromRecordset rs
'6.关闭连接,释放内存
rs.Close
con.Close
Set rs = Nothing
Set con = Nothing
End Sub
三、另辟蹊径，解决问题
正确代码：
Option Explicit
Sub query_mysql_toexcel()
Dim con As Object, objcon As Object, rs As Object
Dim sql As String, customer_name$, cnstr$
Dim driver$, host$, database$, user$, pwd$
Const adUseClient = 3
Set con = CreateObject("adodb.connection")
driver = "driver={MySQL ODBC 8.0 unicode Driver}"
host = "localhost"
database = "corn"
user = "wyj"
pwd = "wyj"
cnstr = driver & "; Server=" & host & ";Database=" & database & ";Uid=" & user & ";Pwd=" & pwd & ";option=3"
con.Open cnstr
customer_name = Sheets(2).Range("M2").Value
sql = "Select date,customer,address,product,小袋规格,大袋规格 From 成品出库 where customer like '%" & customer_name & "%'"
Set rs = CreateObject("adodb.recordset")
rs.CursorLocation = adUseClient
rs.Open sql, con, 1, 3
Dim iRow, iCol As Integer, i As Integer
iRow = 2
Sheet2.Range("A1:K500").Clear
'设置表头
For i = 0 To rs.Fields.Count - 1
Sheet2.Cells(1, i + 1) = rs.Fields(i).name
Next i
'拷贝数据
Sheet2.Range("A2").CopyFromRecordset rs
rs.Close
con.Close
Set rs = Nothing
Set con = Nothing
End Sub
运行结果：
结果正确
三、发现问题
经过与问题代码逐行比对，最后终于发现不同之处，只需要在问题代码这一行：
rs.Open sql, con, adOpenStatic, adLockOptimistic
的上面加上：
rs.CursorLocation = adUseClient
即可得到正解结果。
这一问题让我纠结了很长时间，真是功夫不负有心人，谨以此警示大家，不再被同样的问题骚扰。