使用VBA在Access字段中保存OLE对象

Question

我知道这个主题已被广泛涵盖，但我无法找到解决我特定问题的方法。

我有一个包含OLE对象数据类型列附件的表。表的后端是SQL Server表，其中包含附件列的VARBINARY（MAX）数据类型。

如果我右键单击Access中的附件字段，会弹出一个菜单，其中包含插入对象的选项... 按照此路径我可以插入一个文件在现场。

只需双击该字段，就可以打开以这种方式插入的文件进行查看和编辑。

现在。我需要使用VBA做同样的事情。我需要获取文件列表并将其插入相应行的附件字段中。这应该不是一项艰巨的任务，因为众所周知如何使用ADODB.Stream在字段中插入文件。以下是尝试该概念的简单代码：

Private Sub POC()

    Dim db As DAO.Database
    Dim rsa As DAO.Recordset
    Dim stream As ADODB.stream

    Set db = CurrentDb()
    Set rsa = db.OpenRecordset("ZipCodeAttachments", dbOpenDynaset, dbSeeChanges)

    rsa.MoveFirst
    rsa.MoveNext

    rsa.Edit

    Set stream = New ADODB.stream
    stream.Type = adTypeBinary
    stream.Open
    stream.LoadFromFile Application.CurrentProject.Path & "\Attachments\537.zip"

    rsa.Fields("Attachments").value = stream.Read

    rsa.Update
    rsa.Close

    Set rsa = Nothing
    Set dba = Nothing
End Sub

代码在第二行的附件字段中插入文件。我可以验证通过SSMS添加了该值。但是，当我尝试打开字段进行查看和编辑时，就像我之前使用第一行一样，这次我收到错误：

显然，使用VBA保存文件的方式有问题。

我做错了什么？如何使用VBA获得与Access用户界面相同的结果？

Answer 1

如果你想将一个文件存储为一个OLE包shell对象，那么做一些GUI编码（打开一个带有OLE对象的表单，然后用它来存储文件）是我所知道的唯一方法。

创建一个名为 frmLoadOLEObj 的未绑定表单，其上包含一个名为 MyBoundOLEFrame 的绑定OLE对象。

在表单上，​​添加以下代码：

Public Sub SaveOLEObj(rs As DAO.Recordset, fldName As String, FileName As Variant)
    'Save the position of the recordset
    Dim bkmrk As Variant
    bkmrk = rs.Bookmark
    'Bind the form to the recordset
    Set Me.Recordset = rs
    'Move the form to the saved position
    Me.Bookmark = bkmrk
    'Bind the OLE frame to the field
    MyBoundOLEFrame.ControlSource = fldName
    MyBoundOLEFrame.Class = "Package"
    'Load the attachment into the OLE frame
    MyBoundOLEFrame.SourceDoc = FileName
    MyBoundOLEFrame.Action = acOLECreateEmbed
End Sub

然后，将文件添加到记录中：

Dim rsa As DAO.Recordset
Set rsa = CurrentDb.OpenRecordset("ZipCodeAttachments", dbOpenDynaset, dbSeeChanges)
Dim frmOLE As New Form_frmLoadOLEObj
frmOLE.SaveOLEObj rs, "Attachments", Application.CurrentProject.Path & "\Attachments\537.zip"

正如你所看到的，这非常＆＃34; hacky＆＃34;代码，因为它运行GUI操作，并且您的表单上的代码不是表单，而是真正的模块，但您需要一个表单来控制，因为您无法使用表单控件。我宁愿每天都有BLOB。