如何通过VBA将数据库内的附件添加到表单的附件控件中

错误原因 #

Access 表单的附件控件的fileName/FileType/FileURL等属性均为只读属性，不能直接赋值修改。附件控件的内容完全依赖其绑定的表/查询附件字段，你需要通过 DAO 操作附件字段的子记录集来完成附件写入。

实现步骤 #

前提条件 #

确保你的附件控件attachctrl已经绑定到表单记录源中的一个附件类型字段，假设该字段名为存附件的字段名。

完整实现代码 #

Dim db As DAO.Database
Dim rsSource As DAO.Recordset
Dim rsSourceAttach As DAO.Recordset2
Dim rsTargetAttach As DAO.Recordset2
Dim strSQL As String

Set db = CurrentDb
' 读取源表的附件数据
strSQL = "SELECT [Analysis1] FROM [tblAnalysis] WHERE [ID] = '" & Me.cmb.Value & "'"
Set rsSource = db.OpenRecordset(strSQL, dbOpenDynaset)

If Not rsSource.EOF Then
    ' 获取源附件字段的子记录集
    Set rsSourceAttach = rsSource("Analysis1").Value
    ' 获取当前表单绑定的目标附件字段的子记录集
    Set rsTargetAttach = Me.Recordset("存附件的字段名").Value
    
    ' （可选）如果需要先清空目标字段原有附件，取消注释下方代码
    ' Do While Not rsTargetAttach.EOF
    '     rsTargetAttach.Delete
    '     rsTargetAttach.MoveNext
    ' Loop
    
    ' 遍历源附件，全部添加到目标字段
    rsSourceAttach.MoveFirst
    Do While Not rsSourceAttach.EOF
        rsTargetAttach.AddNew
        rsTargetAttach("FileData").Value = rsSourceAttach("FileData").Value
        rsTargetAttach("FileName").Value = rsSourceAttach("FileName").Value
        rsTargetAttach("FileType").Value = rsSourceAttach("FileType").Value
        rsTargetAttach.Update
        rsSourceAttach.MoveNext
    Loop
    
    ' 保存表单记录
    Me.Dirty = False
    
    ' 释放资源
    rsSourceAttach.Close
    rsTargetAttach.Close
    Set rsSourceAttach = Nothing
    Set rsTargetAttach = Nothing
End If

rsSource.Close
Set rsSource = Nothing
Set db = Nothing

特殊场景说明 #

如果你的表单没有绑定记录源，不能直接使用未绑定的附件控件写入内容，你需要先创建一个临时表，临时表中包含一个附件类型字段，将附件控件绑定到临时表的附件字段，再按上述逻辑操作临时表的附件字段即可。

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