Access 上传图片功能最优解：图片放文件夹，表里只存路径

摘要： 图片数量一多，Access 里直接存二进制就不太划算了。更稳的做法是把图片放到固定文件夹，表里只保存相对路径、文件名和上传时间。这篇用一张表、一个窗体和一段 VBA，把上传、预览、删除这条线跑通。

Hi，大家好！

上一篇我讲了一个办法：用 ADO Stream 读取图片，再用 AppendChunk 写进 OLE 对象 字段。这个方法适合图片少、单张不大的场景，比如员工头像、产品主图、证件照。

文章最后我留了一句话：图真多的话，还是建议图片放文件夹里，库里只存路径和文件名。

这篇就接着把这个方案补上。

我自己做项目时，图片只要开始变多，就会优先考虑这种做法。不是因为它更“高级”，而是因为它更容易维护。库文件不会被图片撑大，迁移时也能看清楚图片到底放在哪里，出了问题也好查。

一、存路径

很多人一听“库里只存路径”，第一反应是：那图片不就不在数据库里了吗？会不会不安全？会不会丢？

这事要分场景。

如果你做的是一个小工具，几百条记录，每条一张小图，整个系统拷给别人就能用，那把图片二进制放库里没问题。

但如果是巡检照片、施工照片、维修照片、产品多角度图片，一条记录可能挂好几张，单张照片又是手机拍出来的几 MB，那就别硬塞进 accdb 了。Access 文件有 2GB 上限，图片一多，压缩修复也救不了多少。

把图片放文件夹里，表里存路径，本质上是把两类数据分开：

表里存结构化信息：标题、记录 ID、文件名、上传时间
文件夹里存非结构化文件：JPG、PNG、PDF、扫描件

这不是退一步，是很多正式项目里更正常的做法。

二、路径尽量存相对路径

这里有个很关键的细节：不要一上来就把完整路径存进表里。

比如这样：

D:\客户资料\图片\202607\001.jpg

看起来没问题，但换一台电脑、换一个盘符、换一个文件夹，路径就废了。更稳一点的做法是存相对路径：

PhotoFiles\202607\20260713153021_12345678.jpg

真正显示图片时，再用 CurrentProject.Path 或共享目录拼出完整路径。

单机版项目，可以把图片文件夹放在当前数据库旁边：

你的系统.accdb
PhotoFiles\
    202607\
        20260713153021_12345678.jpg

如果是前后端分离、多用户共享，就不要把图片放在每个人本机的前端目录里。应该放到共享目录，比如：

\\Server\AccessPhotos\PhotoFiles\202607\xxx.jpg

下面这份代码默认用当前数据库所在目录。真上多人项目时，把 GetPictureRoot 函数改成共享目录就行。

三、建表

新建一张表，叫 tblPhotoPathDemo：

PhotoID：自动编号，主键
Title：短文本，图片对应的标题
PicName：短文本，保存原始文件名
PicExt：短文本，保存扩展名，比如 jpg、png
PicRelPath：短文本，保存图片相对路径
PicSize：数字，长整型，保存文件大小
UpdatedAt：日期/时间，保存最后上传时间

这里没有 OLE 对象 字段，也没有附件字段。

图片本身不进表。表里只记它在哪里。

四、建窗体

基于 tblPhotoPathDemo 建一个窗体，叫 frmPhotoPathDemo，放这几个控件：

txtTitle：文本框，绑定到 Title
txtPicName：文本框，绑定到 PicName，建议锁定
imgPic：图像控件，不绑定字段，用来预览图片
cmdUpload：按钮，标题写“上传图片”
cmdDelete：按钮，标题写“删除图片”

imgPic 还是用图像控件，不要用绑定对象框。它的“图片类型”建议设成“链接”，因为我们显示的是磁盘上的图片文件。

上传前先输入标题，再点上传。代码会复制图片到 PhotoFiles 文件夹，再把相对路径写进表里。

五、完整代码

打开 frmPhotoPathDemo 的窗体代码模块，把下面这段贴进去。

Option Compare Database
Option Explicit

Private Const PHOTO_ROOT_FOLDER As String = "PhotoFiles"
Private Const MAX_FILE_SIZE As Long = 2097152    ' 2 MB

Private Sub cmdUpload_Click()
    On Error GoTo ErrHandler

    Dim sourcePath As String
    Dim targetRelPath As String
    Dim targetFullPath As String
    Dim targetFolder As String
    Dim oldFullPath As String

    sourcePath = PickImageFile()
    If Len(sourcePath) = 0 Then Exit Sub

    If FileLen(sourcePath) > MAX_FILE_SIZE Then
        MsgBox "图片不能超过 2 MB，请先压缩后再上传。", vbExclamation
        Exit Sub
    End If

    If Me.Dirty Then Me.Dirty = False

    oldFullPath = GetStoredPictureFullPath()
    targetRelPath = BuildTargetRelativePath(sourcePath)
    targetFullPath = CombinePath(GetPictureRoot(), targetRelPath)
    targetFolder = Left$(targetFullPath, InStrRev(targetFullPath, "\") - 1)

    EnsureFolderPath targetFolder
    FileCopy sourcePath, targetFullPath

    Me!PicName = GetFileNameOnly(sourcePath)
    Me!PicExt = GetFileExt(sourcePath)
    Me!PicRelPath = targetRelPath
    Me!PicSize = FileLen(sourcePath)
    Me!UpdatedAt = Now()

    If Me.Dirty Then Me.Dirty = False

    Me.imgPic.Picture = targetFullPath

    If Len(oldFullPath) > 0 And oldFullPath <> targetFullPath Then
        DeleteFileIfExists oldFullPath
    End If

    MsgBox "图片已保存到文件夹。", vbInformation
    Exit Sub

ErrHandler:
    MsgBox "上传图片失败：" & Err.Description, vbExclamation
End Sub

Private Sub cmdDelete_Click()
    On Error GoTo ErrHandler

    Dim oldFullPath As String

    If Len(Nz(Me!PicRelPath, "")) = 0 Then
        Me.imgPic.Picture = ""
        Exit Sub
    End If

    If MsgBox("确定要删除当前记录中的图片吗？", vbQuestion + vbYesNo) <> vbYes Then Exit Sub

    oldFullPath = GetStoredPictureFullPath()
    DeleteFileIfExists oldFullPath

    Me!PicName = Null
    Me!PicExt = Null
    Me!PicRelPath = Null
    Me!PicSize = 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 fullPath As String

    fullPath = GetStoredPictureFullPath()

    If Len(fullPath) = 0 Or Len(Dir$(fullPath)) = 0 Then
        Me.imgPic.Picture = ""
    Else
        Me.imgPic.Picture = fullPath
    End If

    Exit Sub

ErrHandler:
    Me.imgPic.Picture = ""
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 BuildTargetRelativePath(ByVal sourcePath As String) As String
    Dim folderName As String
    Dim newFileName As String
    Dim fileExt As String

    fileExt = GetFileExt(sourcePath)
    folderName = PHOTO_ROOT_FOLDER & "\" & Format$(Date, "yyyymm")
    newFileName = Format$(Now(), "yyyymmddhhnnss") & "_" & _
                  Format$(CLng(Timer * 1000), "00000000") & "." & fileExt

    BuildTargetRelativePath = folderName & "\" & newFileName
End Function

Private Function GetPictureRoot() As String
    GetPictureRoot = CurrentProject.Path
    ' 多人项目可改成共享目录，例如：\\Server\AccessPhotos
End Function

Private Function GetStoredPictureFullPath() As String
    Dim storedPath As String

    storedPath = Nz(Me!PicRelPath, "")
    If Len(storedPath) = 0 Then Exit Function

    If InStr(1, storedPath, ":\", vbTextCompare) > 0 Or Left$(storedPath, 2) = "\\" Then
        GetStoredPictureFullPath = storedPath
    Else
        GetStoredPictureFullPath = CombinePath(GetPictureRoot(), storedPath)
    End If
End Function

Private Function CombinePath(ByVal basePath As String, ByVal childPath As String) As String
    If Right$(basePath, 1) = "\" Then
        CombinePath = basePath & childPath
    Else
        CombinePath = basePath & "\" & childPath
    End If
End Function

Private Sub EnsureFolderPath(ByVal folderPath As String)
    Dim parentPath As String

    If Len(folderPath) = 0 Then Exit Sub
    If Len(Dir$(folderPath, vbDirectory)) > 0 Then Exit Sub

    parentPath = Left$(folderPath, InStrRev(folderPath, "\") - 1)

    If Len(parentPath) > 0 And Len(Dir$(parentPath, vbDirectory)) = 0 Then
        EnsureFolderPath parentPath
    End If

    MkDir folderPath
End Sub

Private Sub DeleteFileIfExists(ByVal filePath As String)
    On Error Resume Next

    If Len(filePath) > 0 Then
        If Len(Dir$(filePath)) > 0 Then Kill filePath
    End If
End Sub

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

六、解释一下代码功能

上传时，先选一张图片。代码会检查文件大小，超过 2 MB 就不让传。这个限制不是必须的，但我建议保留。用户手机里随便一张原图就可能十几 MB，不拦一下，文件夹也会很快失控。

通过检查后，代码会在数据库旁边创建一个 PhotoFiles 文件夹，再按年月分子文件夹，比如 PhotoFiles\202607。图片复制进去以后，表里保存的不是完整路径，而是这样的相对路径：

PhotoFiles\202607\20260713153021_12345678.jpg

窗体切换记录时，Form_Current 会调用 ShowCurrentPicture，把相对路径拼成完整路径，再交给 imgPic 显示。如果文件不见了，预览就清空，不会让窗体卡在报错状态。

删除图片时，代码会先删磁盘上的文件，再清空表里的文件名、扩展名、相对路径和大小。

七、多人共享时要改一个地方

上面的示例适合单机版，或者图片文件夹跟着当前数据库文件走的情况。

如果你的系统已经做了前后端分离，每个用户电脑上都有一份前端，那么图片不能放在 CurrentProject.Path 下面。因为每个人的前端路径都不一样，A 上传的图片，B 可能根本看不到。

这种情况下，把 GetPictureRoot 改成一个共享目录：

Private Function GetPictureRoot() As String
    GetPictureRoot = "\\Server\AccessPhotos"
End Function

然后让所有用户都能访问这个共享目录。权限不要只给读，也要给写和删除，否则上传、更换、删除图片都会出问题。

这个地方最好在项目一开始就定好。后面图片多了再迁移目录，也不是不能做，但要补脚本、改路径、核对文件，工作量会明显变大。

八、一条记录多张图怎么放

如果还是一条记录一张图，刚才的 tblPhotoPathDemo 就够了。

但真实项目里，经常是一条产品记录多张图，或者一张维修单多张现场照片。这个时候不要在主表里加 PicRelPath1、PicRelPath2、PicRelPath3。

应该拆成两张表：

tblProduct：保存产品基本信息
tblProductPhoto：保存产品图片

tblProductPhoto 可以这样设计：

PhotoID：自动编号，图片主键
ProductID：长整型，对应产品 ID
PicName：短文本，原始文件名
PicExt：短文本，扩展名
PicRelPath：短文本，相对路径
PicSize：数字，文件大小
SortNo：数字，排序
UploadedAt：日期/时间，上传时间

窗体上用主窗体显示产品，子窗体显示图片列表。上传按钮放在子窗体里。这样图片从一张变成十张，表结构不用动。

九、写在最后

做到这里，其实就剩一个判断：这些图片以后会不会越来越多。

员工头像、产品主图这种，一条记录一张小图，放进库里省事，上一篇的方法就够用。巡检照片、施工照片、合同扫描件这种，今天十张，明天一百张，后面只会越攒越多，就别放access了。

图片放到文件夹以后，表只负责记录数据：这张图属于哪条记录，文件放在哪里，什么时候传上来的。

当然，文件夹也不是随手建一个就完事。共享目录权限、备份策略、误删恢复，都要一起想。尤其是多人用的系统，图片目录要当成业务数据的一部分，不要当成临时附件。

posted @ 2026-07-16 13:16 edonsoft 阅读(3) 评论(0) 收藏举报

刷新页面返回顶部