VB6上位机Access数据库查询优化实战

场景背景

去年在做一个老式 VB6 上位机的维护项目：8 台 S7-200 SMART PLC 通过 Modbus RTU 每 2 秒上报一次电流、电压、温度、产量等参数，上位机把数据写进同机的 Access 2010（.accdb）。运行大半年后设备表涨到 47 万条，操作员点开"历史曲线"页面的时候，列表接口要等 1.2 秒，偶尔还会看到"文件已被锁定"的提示。

Access 不是大型数据库，但用好它也能扛住中小型上位机。这篇文章把我当时排查到的 5 个典型问题和修复代码整理一下，都是真刀真枪的实测数据。

原始代码（反模式集锦）

先说最初那版"能跑就行"的历史查询：

vb
Function GetHistoryList(ByVal devId As Long, ByVal tStart As Date, ByVal tEnd As Date) As Collection
    Dim rs As New ADODB.Recordset
    Dim conn As New ADODB.Connection
    Dim sql As String
    Dim col As New Collection
    
    conn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & DbPath
    
    ' ❌ 问题1: SELECT * + 全表扫描
    ' ❌ 问题2: 日期字段用 # 直接拼接，Access 还要重新解析一次
    sql = "SELECT * FROM DeviceData WHERE DevId = " & devId & _
          " AND CollectTime BETWEEN #" & Format(tStart, "yyyy-mm-dd hh:nn:ss") & _
          "# AND #" & Format(tEnd, "yyyy-mm-dd hh:nn:ss") & "# ORDER BY CollectTime DESC"
    
    rs.Open sql, conn, adOpenKeyset, adLockReadOnly
    Do While Not rs.EOF
        Dim h As New HistoryItem
        h.DevId = rs!DevId
        h.Val1  = rs!Val1
        h.Time  = rs!CollectTime
        col.Add h
        rs.MoveNext
    Loop
    rs.Close
    conn.Close
    Set GetHistoryList = col
End Function

这版本质上是教科书级别的"反模式合集"。我一条条拆。

优化一：建索引 + 只查需要的列

先跑一次 Access 的"查询性能分析器"，它直接告诉我 DeviceData 表缺索引：

sql
-- 在 Access 查询设计器里执行一次，之后不用再跑
-- 或者用 CurrentDb.Execute 动态建
CREATE INDEX idx_DevId_Time ON DeviceData(DevId, CollectTime DESC);

然后把 SELECT * 换成明确列名，Access 会用索引覆盖扫描而不是回表。实测这一步单独就把 1.2s 降到 480ms。

vb
' ✅ 优化1: 只查要的列
sql = "SELECT DevId, Val1, Val2, CollectTime FROM DeviceData " & _
      "WHERE DevId = ? AND CollectTime BETWEEN ? AND ? " & _
      "ORDER BY CollectTime DESC"

优化二：参数化 Command + 预编译

上一步我顺手把 SQL 改成参数化了，但没进一步用 ADODB.Command 做预编译。Access 的 Jet/ACE 引擎对同一个 SQL 字符串会重复解析执行计划——把 Command 对象做成类级别的，反复 .Execute，第二次调用开始就走缓存计划。

vb
' 类级别预编译一次
Private m_cmdHistory As ADODB.Command

Private Sub InitCommands()
    Set m_cmdHistory = New ADODB.Command
    With m_cmdHistory
        .ActiveConnection = m_conn
        .CommandText = "SELECT DevId, Val1, Val2, CollectTime " & _
                       "FROM DeviceData " & _
                       "WHERE DevId = ? AND CollectTime BETWEEN ? AND ? " & _
                       "ORDER BY CollectTime DESC"
        .CommandType = adCmdText
        .Prepared = True   ' ✅ 关键：强制 Jet 预编译执行计划
        .Parameters.Append .CreateParameter(, adBigInt, adParamInput)
        .Parameters.Append .CreateParameter(, adDBTimeStamp, adParamInput)
        .Parameters.Append .CreateParameter(, adDBTimeStamp, adParamInput)
    End With
End Sub

' 每次查询只改参数值
Function GetHistory(ByVal devId As Long, ByVal t1 As Date, ByVal t2 As Date) As ADODB.Recordset
    m_cmdHistory(0).Value = devId
    m_cmdHistory(1).Value = t1
    m_cmdHistory(2).Value = t2
    Set GetHistory = m_cmdHistory.Execute
End Function

这一步之后查询稳定在 180ms 左右。注意 .Prepared = True 在 Jet 上第一次跑的时候会稍慢一点，但后续调用直接命中缓存的执行计划。

优化三：分页别再 MoveNext 硬翻

47 万条数据，操作员只关心最近 200 条。原来的代码把 BETWEEN 时间段所有记录 MoveNext 塞进 Collection 再取前 200，纯粹浪费。Access 没有 MySQL 的 LIMIT/OFFSET，但可以用子查询先圈住主键：

vb
' ✅ 优化3: 子查询分页，只取一页数据
Const PAGE_SIZE As Long = 200

Function GetHistoryPage(ByVal devId As Long, ByVal t1 As Date, ByVal t2 As Date, _
                       ByVal pageNo As Long) As ADODB.Recordset
    Dim cmd As New ADODB.Command
    cmd.ActiveConnection = m_conn
    cmd.CommandText = _
        "SELECT TOP " & PAGE_SIZE & " DevId, Val1, Val2, CollectTime " & _
        "FROM DeviceData " & _
        "WHERE DevId = ? AND CollectTime BETWEEN ? AND ? " & _
        "  AND Id NOT IN (" & _
        "    SELECT TOP " & ((pageNo - 1) * PAGE_SIZE) & " Id " & _
        "    FROM DeviceData WHERE DevId = ? AND CollectTime BETWEEN ? AND ? " & _
        "    ORDER BY CollectTime DESC" & _
        "  ) " & _
        "ORDER BY CollectTime DESC"
    ' 6 个参数绑定（主查询 3 个 + 子查询 3 个）
    For i = 0 To 5
        cmd.Parameters.Append cmd.CreateParameter(, adBigInt, adParamInput)
    Next i
    cmd(0).Value = devId: cmd(1).Value = t1: cmd(2).Value = t2
    cmd(3).Value = devId: cmd(4).Value = t1: cmd(5).Value = t2
    Set GetHistoryPage = cmd.Execute
End Function

子查询查 Id 本身很便宜，因为有索引。这样无论历史跨度是 1 小时还是 1 个月，数据库里只实际取 200 行。

优化四：批量写入用 AddNew + UpdateBatch

跟查询慢一起被投诉的还有"写多了锁文件"。原来的采集循环每条都 .Open/.AddNew/.Update/.Close：

vb
' ❌ 每条都 .Open / .AddNew / .Update / .Close
Do While Not gStop
    For Each dev In gDevices
        Dim rs As New ADODB.Recordset
        rs.Open "DeviceData", conn, adOpenDynamic, adLockOptimistic, adCmdTableDirect
        rs.AddNew
        rs!DevId = dev.Id
        rs!Val1 = dev.ReadCurrent()
        rs!CollectTime = Now
        rs.Update
        rs.Close
    Next dev
    Sleep 2000
Loop

改成客户端游标 + UpdateBatch 批量提交：

vb
' ✅ 整个采集周期只 .Open / .Close 一次
Dim rs As New ADODB.Recordset
rs.CursorLocation = adUseClient
rs.LockType = adLockBatchOptimistic
rs.Open "DeviceData", m_conn, adOpenKeyset, adLockBatchOptimistic, adCmdTableDirect

Do While Not gStop
    rs.AddNew Array("DevId", "Val1", "Val2", "CollectTime"), _
              Array(dev.Id, dev.ReadCurrent(), dev.ReadVoltage(), Now)
    If rs.RecordCount Mod 50 = 0 Then
        rs.UpdateBatch adAffectAll   ' 攒够 50 条批量写
    End If
    Sleep 2000
Loop
rs.UpdateBatch adAffectAll   ' 最后剩的落盘
rs.Close

Jet 引擎只做一次索引更新 + 一次页写入，锁持有从每条 3~5ms 降到批量约 15ms，几乎感受不到。

实测对比汇总

同一组数据（devId=3, 时间跨度 = 最近 7 天，约 1.2 万条匹配记录）：

原始版本 (SELECT * + 无索引 + 循环 MoveNext)           : 1240 ms
  ↓ 加索引 + 指定列名                                 :  480 ms
  ↓ Command 预编译 + 参数化                           :  180 ms
  ↓ 子查询分页 (只取 200 条)                           :   85 ms

写入路径：
原始版本 (每条 Open/Close)                            :  260 ms/秒
  ↓ AddNew + UpdateBatch 每 50 条批量                  :   32 ms/秒

其他踩过的坑

Win64 下要装 Access Database Engine x64，VB6 IDE 是 32 位，但编译后的 exe 如果按 64 位跑会"找不到 Provider"。用哪个位数的 Engine，编译就要对应哪个位数。

日期格式必须是 yyyy-mm-dd hh:nn:ss（分钟是 nn 不是 mm），否则 0~9 分钟会被解析成 0~9 月。

Jet 删除数据不会立即回收磁盘空间，半年跑一次 DAO 的 CompactDatabase，文件能缩 30%~50%，查询又会快一截。

小结

Access 不是工业数据库的终点，但数据量稳定在百万行以内时，用对索引、预编译、批量写入这三板斧，性能完全够用。真正要上 7x24 小时、每秒千条级采集的时候，再迁移 SQL Server Express 或 PostgreSQL 也不迟——那时这篇文章里的 SQL 优化思路照样用得上。
VB6Access上位机SQL优化