VBA 中使用 ADODB 操作 SQLite 插入中文乱码问题

问题

使用 VBA 的 ADODB 对象的 command 对象、parameter 对象，插入的中文数据为乱码

使用的 ODBC 驱动（需要梯子才能下载）

http://www.ch-werner.de/sqliteodbc/

基础配置

1. 在 VBA 代码编辑器中，点击"工具" --> "引用"

2. 勾选 ActiveX Data Object (若有多个版本建议选最新的) 、Scripting Runtime

示例代码

Function demo(dbPath as string) As Boolean
    On Error GoTo errorHandler
    
    ' 初始化变量
    Dim conn As ADODB.Connection
    Dim cmd As ADODB.Command
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim lastrow As Long
    Dim stationName As String

    ' ------------------------------- 业务相关逻辑 ------------------------------- 
    ' 打开工作簿，工作簿文件绝对路径(包含文件名+后缀) = FilePath
    Set wb = Workbooks.Open(FilePath, ReadOnly:=True)

    ' 获取第二个sheet
    Set ws = wb.Worksheets(2)
    stationName = ws.Name

    '获取表格行数
    lastrow = ws.Cells(ws.Rows.count, "C").End(xlUp).row
    '总数减去标题行
    totalCount = lastrow - 2
    ' ---------------------------- 业务相关逻辑 - 结束 ---------------------------- 

    ' 建立连接
    ' dbpath = SQLite 数据库文件的绝对路径
    Set conn = New ADODB.Connection
    conn.Open "DRIVER={SQLite3 ODBC Driver};Database=" & dbPath & ""

    ' 建立指令对象
    Set cmd = New ADODB.Command
    ' 指令语句 ? 为占位符，之后调用 parameter 方法进行替换
    sql = "INSERT INTO devList (deviceNumber, deviceIdentifier, deviceChineseName, " & _
          "deviceDrawingCode, moduleBoxNumber, stationName) VALUES (?, ?, ?, ?, ?, ?)"
    With cmd
        .ActiveConnection = conn
        .CommandText = sql
        .CommandType = adCmdText

	    ' 数据集对象：清除之前的参数
	    While .Parameters.count > 0
	        .Parameters.Delete 0
	    Wend

        '创建参数域
        .Parameters.Append .CreateParameter("p1", adVarChar, adParamInput, 255, "P1")  'C  设备编号
        .Parameters.Append .CreateParameter("p2", adVarChar, adParamInput, 255, "P2")  'G  设备标识
        .Parameters.Append .CreateParameter("p3", adVarChar, adParamInput, 255, "P3")  'J  设备中文名
        .Parameters.Append .CreateParameter("p4", adVarChar, adParamInput, 255, "P4")  'L  设备图纸代码
        .Parameters.Append .CreateParameter("p5", adVarChar, adParamInput, 255, "P5")  'N  模块箱编号
        .Parameters.Append .CreateParameter("p6", adVarChar, adParamInput, 255, "P6")  '站点名
        .Parameters.Append .CreateParameter("p7", adVarChar, adParamInput, 255, "P7")  'H  设备安装分区
    End With

    ' 开启事务，批量插入
    conn.BeginTrans
    
    ' 各行数据批量插入
    For i = 3 To lastrow
                
        ' ------------------------------- 业务相关逻辑 --------------------------
        ' 每行各列数据与数据集对象绑定
        cmd("p1") = CStr(ws.Cells(i, "C").Value)
        cmd("p2") = CStr(ws.Cells(i, "G").Value)
        cmd("p3") = CStr(ws.Cells(i, "J").Value)
        cmd("p4") = CStr(ws.Cells(i, "L").Value)
        cmd("p5") = CStr(ws.Cells(i, "N").Value)
        cmd("p6") = stationName
        ' ---------------------------- 业务相关逻辑 - 结束 ----------------------
        
        ' 执行插入
        cmd.Execute
        
        progressCount = progressCount + 1
        Application.StatusBar = "处理进度... " & progressCount & "/" & totalCount
        DoEvents
    Next i

    '提交事务
    conn.CommitTrans

errorHandler:
    demo_dbProcess = False
    MsgBox "数据导入 SQLite 错误：" & Err.Description, vbCritical
    '回滚 -> 数据库断开 -> 对象释放
    If Not conn Is Nothing Then
        conn.RollbackTrans
        If conn.State = adStateOpen Then
            conn.Close
        End If
        Set conn = Nothing
    End If
    Exit Function
    
Cleanup:
    '正常执行完成的清理工作
    demo_dbProcess = True
    conn.Close
    Set conn = Nothing
    If Not wb Is Nothing Then wb.Close False
    Application.StatusBar = False
End Function

插入时发现中文变成了乱码

问题解决

使用 SQLite ODBC 注意以下问题，才能防止中文等非英文字符操作错误

1. 在 ODBC 连接字中使用以下参数

   1. OEMCP=1：数据库驱动会自动处理字符的编码，保证写入正确

   2. NOWCHAR=0：（这是驱动的默认值，可以不加）设置允许使用 WCHAR 数据类型，保证上面插入的数据在 SQLite 中显示正确

   3. 最终的连接字如下

      "DRIVER={SQLite3 ODBC Driver};Database=<数据库路径>;OEMCP=1;"

2. ADODB 的 parameter 对象，对应 SQLite 中 varchar 类型的变量，应定义为宽字型adVarWChar而不是adVarChar，保证 parameter 对象传入驱动的数据字符是正确的

   .Parameters.Append .CreateParameter("p1", adVarWChar, adParamInput, 255, "P1")  
   .Parameters.Append .CreateParameter("p2", adVarWChar, adParamInput, 255, "P2") 
   .Parameters.Append .CreateParameter("p3", adVarWChar, adParamInput, 255, "P3") 
   .Parameters.Append .CreateParameter("p4", adVarWChar, adParamInput, 255, "P4")  
   .Parameters.Append .CreateParameter("p5", adVarWChar, adParamInput, 255, "P5")  
   .Parameters.Append .CreateParameter("p6", adVarWChar, adParamInput, 255, "P6") 
   .Parameters.Append .CreateParameter("p7", adVarWChar, adParamInput, 255, "P7")

上面的示例代码改进后如下

Function demo_dbProcess(dbPath as string) As Boolean
    ' 初始化变量
    Dim conn As ADODB.Connection
    Dim cmd As ADODB.Command
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim lastrow As Long
    Dim stationName As String

    ' ------------------------------- 业务相关逻辑 ------------------------------- 
    ' 打开工作簿，工作簿文件绝对路径(包含文件名+后缀) = FilePath
    Set wb = Workbooks.Open(FilePath, ReadOnly:=True)

    ' 获取第二个sheet
    Set ws = wb.Worksheets(2)
    stationName = ws.Name

    '获取表格行数
    lastrow = ws.Cells(ws.Rows.count, "C").End(xlUp).row
    '总数减去标题行
    totalCount = lastrow - 2
    ' ---------------------------- 业务相关逻辑 - 结束 ---------------------------- 

    ' 建立连接
    ' dbpath = SQLite 数据库文件的绝对路径
    Set conn = New ADODB.Connection
    conn.Open "DRIVER={SQLite3 ODBC Driver};Database=" & dbPath & ";OEMCP=1;"

    ' 建立指令对象
    Set cmd = New ADODB.Command
    ' 指令语句 ? 为占位符，之后调用 parameter 方法进行替换
    sql = "INSERT INTO devList (deviceNumber, deviceIdentifier, deviceChineseName, " & _
          "deviceDrawingCode, moduleBoxNumber, stationName) VALUES (?, ?, ?, ?, ?, ?)"

    With cmd
        .ActiveConnection = conn
        .CommandText = sql
        .CommandType = adCmdText

	    ' 数据集对象：清除之前的参数
	    While .Parameters.count > 0
	        .Parameters.Delete 0
	    Wend

        '创建参数域
        .Parameters.Append .CreateParameter("p1", adVarWChar, adParamInput, 255, "P1")  'C  设备编号
        .Parameters.Append .CreateParameter("p2", adVarWChar, adParamInput, 255, "P2")  'G  设备标识
        .Parameters.Append .CreateParameter("p3", adVarWChar, adParamInput, 255, "P3")  'J  设备中文名
        .Parameters.Append .CreateParameter("p4", adVarWChar, adParamInput, 255, "P4")  'L  设备图纸代码
        .Parameters.Append .CreateParameter("p5", adVarWChar, adParamInput, 255, "P5")  'N  模块箱编号
        .Parameters.Append .CreateParameter("p6", adVarWChar, adParamInput, 255, "P6")  '站点名
        .Parameters.Append .CreateParameter("p7", adVarWChar, adParamInput, 255, "P7")  'H  设备安装分区
    End With

    ' 开启事务，批量插入
    conn.BeginTrans
    
    ' 各行数据批量插入
    For i = 3 To lastrow

        ' ------------------------------- 业务相关逻辑 ------------------------------- 
        ' 每行各列数据与数据集对象绑定
        cmd("p1") = CStr(ws.Cells(i, "C").Value)
        cmd("p2") = CStr(ws.Cells(i, "G").Value)
        cmd("p3") = CStr(ws.Cells(i, "J").Value)
        cmd("p4") = CStr(ws.Cells(i, "L").Value)
        cmd("p5") = CStr(ws.Cells(i, "N").Value)
        cmd("p6") = stationName
        ' ---------------------------- 业务相关逻辑 - 结束 ---------------------------- 
        
        ' 执行插入
        cmd.Execute

        '进度输出
        progressCount = progressCount + 1
        Application.StatusBar = "处理进度... " & progressCount & "/" & totalCount
        DoEvents
    Next i

    '提交事务
    conn.CommitTrans

errorHandler:
    demo_dbProcess = False
    MsgBox "数据导入 SQLite 错误：" & Err.Description, vbCritical
    '回滚 -> 数据库断开 -> 对象释放
    If Not conn Is Nothing Then
        conn.RollbackTrans
        If conn.State = adStateOpen Then
            conn.Close
        End If
        Set conn = Nothing
    End If
    Exit Function
    
Cleanup:
    '正常执行完成的清理工作
    demo_dbProcess = True
    conn.Close
    Set conn = Nothing
    If Not wb Is Nothing Then wb.Close False
    Application.StatusBar = False
End Function