通过VBA+ODBC连接MySQL在Excel中创建链接表的问题

我有一个Excel文件，需要通过ODBC连接MySQL数据库。我知晓可通过UI操作（数据-获取数据-来自其他源-来自ODBC）实现，但更倾向于使用VBA完成该操作。我已在Access中成功创建了与UI操作一致的链接表，但在Excel中尚未找到可行方案。目前我编写的一段VBA代码可成功建立连接，但在从数据库获取数据时生成的Excel表格出现异常：数字被转换为日期、部分数据甚至未加载等。

当前使用的Excel VBA代码：

Function connect2mssql()

Dim con As ADODB.connection
Dim rs As ADODB.Recordset
Set con = New ADODB.connection
Dim SQL As String
con.Open "DRIVER={MySQL ODBC 5.3 Unicode Driver};SERVER=192.168.12.192;DATABASE=rezervni_deli;UID=vzdrzevalec;PWD=unichem"

''####################

SQL = "SELECT * FROM rezervni_deli;"
Set rs = New ADODB.Recordset

rs.Open SQL, con

For intColIndex = 0 To rs.Fields.Count - 1
    Worksheets("rezervni_deli").Range("A1").Offset(0, intColIndex).Value = rs.Fields(intColIndex).Name
Next

Worksheets("rezervni_deli").Range("A2").CopyFromRecordset rs

''####################

SQL = "SELECT * FROM p_linija;"
Set rs = New ADODB.Recordset

rs.Open SQL, con

For intColIndex = 0 To rs.Fields.Count - 1
    Worksheets("p_linija").Range("A1").Offset(0, intColIndex).Value = rs.Fields(intColIndex).Name
Next

Worksheets("p_linija").Range("A2").CopyFromRecordset rs

''####################

rs.Close
Set rs = Nothing
End Function

解决数据格式异常的实用方案 #

1. 提前锁定单元格格式

在写入数据前，将目标工作表的单元格格式设置为对应类型，避免Excel自动识别转换：

' 示例：将工作表所有列设为文本格式，防止数字被转成日期
Worksheets("rezervni_deli").Columns.NumberFormat = "@"
' 针对特定列设置数值格式（如第2列）
Worksheets("rezervni_deli").Columns(2).NumberFormat = "0"

将这段代码放在写入表头和数据的逻辑之前执行。

2. 优化连接与Recordset配置

• 连接字符串添加字符集参数，避免编码导致的数据丢失：

  con.Open "DRIVER={MySQL ODBC 5.3 Unicode Driver};SERVER=192.168.12.192;DATABASE=rezervni_deli;UID=vzdrzevalec;PWD=unichem;CHARSET=utf8mb4"
  

• 打开Recordset时指定游标类型，提升数据读取稳定性：

  rs.Open SQL, con, adOpenStatic, adLockReadOnly
  

3. 明确SQL字段类型转换

对于容易被Excel误判的字段（如类似日期的数字串），在SQL中显式转换为字符串：

SELECT CAST(your_field AS CHAR) AS your_field, other_fields FROM rezervni_deli;

4. 简化代码逻辑，减少冗余

将写入表头和数据的逻辑封装为子过程，提升代码可维护性：

Sub WriteRsToSheet(rs As ADODB.Recordset, targetWs As Worksheet)
    Dim colIdx As Integer
    ' 清空原有数据
    targetWs.Cells.Clear
    ' 写入表头
    For colIdx = 0 To rs.Fields.Count - 1
        targetWs.Cells(1, colIdx + 1).Value = rs.Fields(colIdx).Name
    Next
    ' 写入数据
    If Not rs.EOF Then
        targetWs.Cells(2, 1).CopyFromRecordset rs
    End If
End Sub

修改主函数调用该子过程：

Function connect2mssql()
    Dim con As ADODB.connection
    Dim rs As ADODB.Recordset
    Dim SQL As String
    
    Set con = New ADODB.connection
    con.Open "DRIVER={MySQL ODBC 5.3 Unicode Driver};SERVER=192.168.12.192;DATABASE=rezervni_deli;UID=vzdrzevalec;PWD=unichem;CHARSET=utf8mb4"
    
    ' 处理rezervni_deli表
    SQL = "SELECT * FROM rezervni_deli;"
    Set rs = New ADODB.Recordset
    rs.Open SQL, con, adOpenStatic, adLockReadOnly
    ' 提前设置格式
    Worksheets("rezervni_deli").Columns.NumberFormat = "@"
    WriteRsToSheet rs, Worksheets("rezervni_deli")
    rs.Close
    
    ' 处理p_linija表
    SQL = "SELECT * FROM p_linija;"
    Set rs = New ADODB.Recordset
    rs.Open SQL, con, adOpenStatic, adLockReadOnly
    Worksheets("p_linija").Columns.NumberFormat = "@"
    WriteRsToSheet rs, Worksheets("p_linija")
    rs.Close
    
    con.Close
    Set rs = Nothing
    Set con = Nothing
End Function

内容的提问来源于stack exchange，提问作者Gasper Kadivec