摘要： 一张 200KB 的 JPG，用"插入对象"存进 Access，可能变成 2MB。图片一多，数据库肥得没法看。这篇讲一个老办法：用 ADO Stream 读取图片，再用 AppendChunk 写入 OLE 对象字段，按原格式保存并还原预览。方法不新，但确实好用。access开发|access培训|access框架|请添加edonsoft。
Hi，大家好！
前阵子有个朋友找我，说他做的产品档案系统越用越慢，库文件三百多 MB，打开要等半天。他挺纳闷：总共也就几百条产品记录，一条记录一张图，怎么会这么大？
我远程看了一眼，问题出在图片的存法上——他是在绑定对象框里右键"插入对象"，一张一张把图片插进去的。
这个操作本身没毛病，Access 就是这么设计的。坑在后面：JPG、PNG 这类图片经过"插入对象"存进去，会被包装成 OLE 对象，体积直接翻好几倍。更早的 Access 版本干脆把图转成位图，一张 200KB 的照片进去，出来就是几 MB。
后来我帮他把存图的方式改了改，别的什么都没动，再压缩修复一下，300 多 MB 变成不到 50MB。那今天我们就来看看我是怎么实现的。
图片能不能存进 Access？能。该不该存？得看情况。
头像、产品主图、证件照这类，一条记录一两张、单张几百 KB 的，存库里没问题，还有个好处——整个系统就一个文件，拷走就能用，不用担心图片文件夹丢了、路径变了。
但要是巡检照片、施工现场图、高清扫描件这种，一条记录挂十几张、动不动一张好几 MB 的，就别往库里塞了。accdb 有 2GB 的硬上限，这么存撑不了多久。我就见过一个巡检系统，上线不到半年库就顶到头了，最后只能连夜改造。这种场景应该图片放文件夹或者服务器，库里只记路径和文件名。
一句话：图少存库里，图多存路径。今天讲的方法属于前一种。
"插入对象"为什么会让图片变大？因为 Access 存的不是图片文件本身，而是一个 OLE 对象——除了图片数据，里面还带了一堆用来支持"双击可编辑"的包装信息。2007 之前的版本更夸张，会把图片转成未压缩的位图，JPG 辛辛苦苦压缩的那点体积优势直接归零。
那就换个思路：不让 Access 碰这张图，把它当成一个普通文件，用 ADO 的 Stream 对象按二进制原样读进来，写到表字段里。文件多大，存进去就多大，一个字节都不多。
显示的时候反过来：把字段里的二进制读出来，在临时文件夹里还原成图片文件，让图像控件去显示这个临时文件。
顺带说一句，Stream 对象要 ADO 2.5 以上才有。这个不用操心，现在还能跑起来的 Access 环境都远高于这个版本。
思路就这么点，下面动手。
新建一张表，叫 tblPhotoDemo：
PhotoID：自动编号，主键
Title：短文本，图片对应的标题，比如产品名称、员工姓名
PicName：短文本，保存图片原始文件名
PicExt：短文本，图片扩展名，比如 jpg、png
PicData：OLE 对象，用来保存图片二进制数据
UpdatedAt：日期/时间，记录上传或修改时间
看到 PicData 是 OLE 对象类型，可能有人要问：绕了半天，最后不还是 OLE 字段吗？
字段类型确实是，但这个类型说白了就是个能装二进制的容器，关键看你往里装什么。右键"插入对象"装进去的是带包装的 OLE 数据；我们用代码装进去的是图片文件的原始字节。容器一样，内容物完全不同。
基于 tblPhotoDemo 建一个窗体，叫 frmPhotoDemo，放这几个控件：
txtTitle：文本框，绑定到 Title 字段，用来输入标题
txtPicName：文本框，绑定到 PicName 字段，显示图片文件名
imgPic：图像控件，不绑定字段，用来预览图片
cmdUpload：按钮，标题写"上传图片"或者"更换图片"
cmdDelete：按钮，标题写"删除图片"
两个容易踩的细节：
一是 imgPic 用的是图像控件，不是绑定对象框，别拖错了。它的"图片类型"属性要设成"链接"，因为后面代码会把库里的二进制还原到临时文件，再让它显示这个临时文件。
二是 txtPicName 的"锁定"属性设成"是"。文件名由代码写入就行，让用户手填只会填出各种花样。
打开 frmPhotoDemo 的窗体代码模块，把下面这段整个贴进去。我用的是后期绑定写法，不用去引用里勾 ADO，贴完直接就能跑。
注意这里不要写成 Me!PicData = stm.Read。图片稍微大一点，就可能遇到“字段太小而不能接受所要添加的数据的数量”。OLE 对象字段这种长二进制数据，用 AppendChunk 写入会稳很多。
如果你已经遇到这个报错，先检查表设计：PicData 必须是“短文本/长文本/附件”以外的字段类型，这里要用 OLE 对象 字段来承接二进制数据。
Option Compare Database
Option Explicit
Private Const adTypeBinary As Long = 1
Private Const adModeReadWrite As Long = 3
Private Const adSaveCreateOverWrite As Long = 2
Private Const CHUNK_SIZE As Long = 32768
Private Sub cmdUpload_Click()
On Error GoTo ErrHandler
Dim filePath As String
Dim stm As Object
Dim rs As Object
Dim binaryData As Variant
filePath = PickImageFile()
If Len(filePath) = 0 Then Exit Sub
If Me.Dirty Then Me.Dirty = False
Set stm = CreateObject("ADODB.Stream")
stm.Type = adTypeBinary
stm.Mode = adModeReadWrite
stm.Open
stm.LoadFromFile filePath
stm.Position = 0
binaryData = stm.Read
Set rs = Me.RecordsetClone
rs.Bookmark = Me.Bookmark
rs.Edit
rs!PicData = Null
rs.Update
rs.Bookmark = Me.Bookmark
rs.Edit
rs!PicName = GetFileNameOnly(filePath)
rs!PicExt = GetFileExt(filePath)
rs!UpdatedAt = Now()
rs.Update
Me.Refresh
Me.imgPic.Picture = filePath
MsgBox "图片上传成功。", vbInformation
CleanExit:
On Error Resume Next
If Not stm Is Nothing Then
If stm.State <> 0 Then stm.Close
End If
If Not rs Is Nothing Then rs.Close
Set stm = Nothing
Set rs = Nothing
Exit Sub
ErrHandler:
MsgBox "图片上传失败：" & Err.Description, vbExclamation
Resume CleanExit
End Sub
Private Sub cmdDelete_Click()
On Error GoTo ErrHandler
If IsNull(Me!PicData) Then
Me.imgPic.Picture = ""
Exit Sub
End If
If MsgBox("确定要删除当前记录中的图片吗？", vbQuestion + vbYesNo) <> vbYes Then Exit Sub
Me!PicData = Null
Me!PicName = Null
Me!PicExt = Null
Me!UpdatedAt = Now()
Me.imgPic.Picture = ""
If Me.Dirty Then Me.Dirty = False
MsgBox "图片已删除。", vbInformation
Exit Sub
ErrHandler:
MsgBox "删除图片失败：" & Err.Description, vbExclamation
End Sub
Private Sub Form_Current()
ShowCurrentPicture
End Sub
Private Sub ShowCurrentPicture()
On Error GoTo ErrHandler
Dim stm As Object
Dim rs As Object
Dim tempPath As String
Dim totalSize As Long
Dim offset As Long
Dim bytesToRead As Long
Dim chunkData As Variant
If IsNull(Me!PicData) Then
Me.imgPic.Picture = ""
Exit Sub
End If
tempPath = BuildTempImagePath()
Set rs = Me.RecordsetClone
rs.Bookmark = Me.Bookmark
If IsNull(rs!PicData.Value) Then
Me.imgPic.Picture = ""
GoTo CleanExit
End If
totalSize = rs!PicData.FieldSize
If totalSize <= 0 Then
Me.imgPic.Picture = ""
GoTo CleanExit
End If
Set stm = CreateObject("ADODB.Stream")
stm.Type = adTypeBinary
stm.Mode = adModeReadWrite
stm.Open
Do While offset < totalSize
bytesToRead = CHUNK_SIZE
If offset + bytesToRead > totalSize Then bytesToRead = totalSize - offset
chunkData = rs!PicData.GetChunk(offset, bytesToRead)
stm.Write chunkData
offset = offset + bytesToRead
Loop
stm.SaveToFile tempPath, adSaveCreateOverWrite
stm.Close
Me.imgPic.Picture = tempPath
CleanExit:
On Error Resume Next
If Not stm Is Nothing Then
If stm.State <> 0 Then stm.Close
End If
If Not rs Is Nothing Then rs.Close
Set stm = Nothing
Set rs = Nothing
Exit Sub
ErrHandler:
Me.imgPic.Picture = ""
Resume CleanExit
End Sub
Private Function PickImageFile() As String
With Application.FileDialog(3)
.Title = "请选择要上传的图片"
.AllowMultiSelect = False
.Filters.Clear
.Filters.Add "图片文件", "*.jpg;*.jpeg;*.png;*.gif;*.bmp"
If .Show = -1 Then
PickImageFile = .SelectedItems(1)
Else
PickImageFile = ""
End If
End With
End Function
Private Function GetFileNameOnly(ByVal filePath As String) As String
GetFileNameOnly = Mid$(filePath, InStrRev(filePath, "\") + 1)
End Function
Private Function GetFileExt(ByVal filePath As String) As String
Dim fileName As String
Dim dotPos As Long
fileName = GetFileNameOnly(filePath)
dotPos = InStrRev(fileName, ".")
If dotPos > 0 Then
GetFileExt = LCase$(Mid$(fileName, dotPos + 1))
Else
GetFileExt = "jpg"
End If
End Function
Private Function BuildTempImagePath() As String
Dim fileName As String
Dim fileExt As String
Dim recordKey As String
fileName = Nz(Me!PicName, "preview.jpg")
fileExt = Nz(Me!PicExt, "jpg")
If Nz(Me!PhotoID, 0) > 0 Then
recordKey = CStr(Me!PhotoID)
Else
recordKey = Format$(Now(), "yyyymmddhhnnss")
End If
If InStrRev(fileName, ".") = 0 Then
fileName = fileName & "." & fileExt
End If
BuildTempImagePath = Environ$("Temp") & "\AccessPic_" & recordKey & "_" & fileName
End Function
注意，我这里用的绑定窗体，上传前先输入一下标题，上传后标题和图片文件名都会写进表里。
上传的时候，先弹文件对话框选图，选完用 ADODB.Stream 按二进制把文件读进来，再通过 RecordsetClone 找到当前记录，用 AppendChunk 写进 PicData 字段，顺手记一下文件名、扩展名和时间，最后让图像控件显示刚选的这张图。
切换记录的时候反过来：先看当前记录有没有 PicData，有就用 GetChunk 把二进制分块读出来，写回临时文件夹，还原成图片文件给 imgPic 显示；没有就清空预览。这部分逻辑在 Form_Current 事件里，所以翻记录的时候图片会自动跟着切。
整套东西拆开看就一句话：库里存的是图片原始字节，窗体上显示的是临时还原出来的文件。OLE 包装绕过去了，预览也没耽误。
上面的例子是一条记录一张图。要是需求变成"一条产品记录传多张图"，很多人的第一反应是往表里加字段：
PicData1
PicData2
PicData3
PicData4
像这种横着加字段的设计，图片数量一变就要改表改窗体，迟早改到怀疑人生。正确的做法是拆成主表加明细表：
tblProductPhoto 可以这样设计：
PhotoID：自动编号，图片主键
ProductID：长整型，对应产品 ID
PicName：短文本，图片文件名
PicExt：短文本，图片扩展名
PicData：OLE 对象，图片二进制数据
SortNo：数字，图片排序
UpdatedAt：日期/时间，上传时间
窗体上用主窗体显示产品信息，子窗体显示图片列表，上传按钮放在子窗体里。一对多的关系，就该用一对多的表去装。
示例代码能跑，不代表能直接上生产。真放进项目里，建议把这几条也加上。
1. 限制图片大小
单张限制在 1MB 或 2MB 以内，上传前加一句判断就行：
If FileLen(filePath) > 2 * 1024 * 1024 Then
MsgBox "图片不能超过 2 MB，请先压缩后再上传。", vbExclamation
Exit Sub
End If
别嫌这条啰嗦。accdb 那 2GB 的上限就摆在那，不拦着点，用户什么都敢往里传——手机随手一拍就是十几 MB。
2. 统一图片格式
头像、产品图这类，统一成 JPG 或 PNG。格式越杂，后面导出、预览、迁移越闹心。
3. 记下谁传的、什么时候传的
表里加两个字段，UploadedBy 存上传人，UploadedAt 存上传时间。平时不起眼，出了问题要追溯的时候你会感谢自己。
4. 图真多的话，回到"文件夹 + 路径"
前面说过了，图片量大就别硬塞库里。文件放文件夹或服务器，库里只存路径、文件名、记录 ID、上传时间。库轻了，图片备份迁移也方便。
二进制存库里（本文的方法）： 系统就一个文件，拷走就能用。代价是库会跟着图片长，只适合图少的场景。
图片存文件夹，库里存路径： 库轻，图片再多也不怕，但要管好文件夹和路径，换电脑、换服务器时要留神。
绑定对象框"插入对象"： 操作最省事，体积代价最大。演示 demo 随便用，正式项目就算了。
我自己的取舍很简单：图少用第一种，图多用第二种，第三种基本不碰。
Access里面是可以存图片的，但要注意存法。存错了，库就会膨胀得很快，影响性能和迁移。目前我这个方法也不最优解，最优解是把图片存到文件夹里，库里只存路径和文件名。这个我们下篇再讲。
如果你的团队正在用 Access，或者计划用 Access 搭建业务系统，我们可以提供从培训到落地的全流程支持：
技术培训
定制开发
技术支持
无论是想让团队快速上手 Access 开发，还是需要把现有系统接上 AI，都可以直接联系我们聊聊方案。
联系方式