如何从Ms访问创建ole对象

Question

我有一个带有嵌入图片（OLE）库的表。

我希望能够通过带有浏览选项的表单插入新记录。

无论如何，我有一个文件名，我需要把它变成一个ole对象并插入到表单中。如何在VBA中做到这一点？

为了澄清-我需要将文件名转换为该文件的ole对象，然后将其插入表中

谢谢，Fingerman。

编辑：

好的，正如@HansUp所指出的，我需要解释一下。在我的表单中，我有一个绑定的OLE对象，它不是绑定到字段，而是绑定到dlookup函数。我通过查询和组合框将正确的id输入到控件中，因此控制器绑定到：

=DLookUp("picture","articles","id=" & [articles])

请注意，articles不是一个字段，而是一个控制器，我不知道这是否有任何区别。

每次更改控制器时，我都使用me.recalc，这样绑定的OLE就可以更新它的值。

无论如何，我想通过VBA和用户输入文件地址来实现这一点，而不使用控制器，而是使用某种INSERT或其他方式，但也欢迎其他选项。

如果我不清楚，询问！我会澄清并修正自己

编辑2:

那么文件名是如何获取的呢派生？您是否希望使用文章ID？照片总是在预期位置文件名？你到底想干什么如果不使用"浏览"按钮，该怎么办？你在全力寻找什么吗基于文件夹和文件的自动化名字还是你在找什么比如拖放？

文件名是通过浏览选项获得的，我已经实现了。为了简化起见，假设用户必须在文本框中自己输入文件名。现在——我希望点击一个按钮，就可以将该文件名作为嵌入的ole对象插入到我的数据库中。我不寻求任何自动化或拖放（但是，如果拖放工作，那将是伟大的）。自从有人问起，第一次编辑是关于ole控制器的。他认为我的问题可以用那个控制器解决——所以我详细介绍了我是如何鄙视这张照片的。我不认为它有任何相关性，但如果有人可以使用它，我也可以。我希望使用articleID进行更新，但我不知道这与问题有什么关系。

我开始认为这可能是不可能的……：(这是不幸的，因为这个问题是相当直接的如果您有一个文件名，则需要将其作为OLE对象嵌入数据库中

Answer 1

在提供答案之前，我将快速了解一下您的问题及其要求。在我看来，您似乎希望能够使用VBA、表中的OLE对象字段和绑定对象框架加载二进制文件对象，在本例中为图片。

最好的选择是停止尝试使用绑定对象帧，因为它有太多的限制。

基本上有两种推荐的方法来做你想做的事情

1） 只存储图像文件的链接，然后使用图像控件（可以绑定到图片字段）来显示图像。

2） 将图像存储在OLE对象字段中，使用代码将图像作为二进制数据读取。当您需要显示图像时，您需要将其写入临时文件，然后可以将图像控件上的"图片"属性设置为临时图像文件的完整路径和文件名。将由您将图像文件作为临时文件进行管理。您可以使用Windows的临时目录，也可以在每次需要显示图像时直接写入相同的文件名。

这两种技术都不太难。这里有一篇非常好的文章可以帮助你进一步理解我在说什么：http://www.jamiessoftware.tk/articles/handlingimages.html

这里有一个读取二进制数据的函数（在本例中为图片文件）和另一个写入二进制数据的功能：http://www.ammara.com/access_image_faq/read_write_blob.html这适用于将图片写入"临时"文件。然后，您所要做的就是将图像控件上的Picture属性设置为临时文件的文件路径和名称。

您还可以使用ADO Stream对象以及ADO RecordSet对象和ADO Connection对象读取和写入二进制数据。您必须在Access to Microsoft ActiveX Data Objects 2.8 Library中设置引用。

以下是一些使用ADO:将图片添加到数据库的代码

Private Function LoadPicIntoDatabase(sFilePathAndName As String) As Boolean
On Error GoTo ErrHandler
    'Test to see if the file exists. Exit if it does not.
    If Dir(sFilePathAndName) = "" Then Exit Function
    LoadPicIntoDatabase = True
    'Create a connection object
    Dim cn As ADODB.Connection
    Set cn = CurrentProject.Connection
    'Create our other variables
    Dim rs As ADODB.Recordset
    Dim mstream As ADODB.Stream
    Set rs = New ADODB.Recordset
    'Configure our recordset variable and open only 1 record (if one exists)
    With rs
        .LockType = adLockOptimistic
        .CursorLocation = adUseClient
        .CursorType = adOpenDynamic
        .Open "SELECT TOP 1 * FROM tblArticles", cn
    End With
    'Open our Binary Stream object and load our file into it
    Set mstream = New ADODB.Stream
    mstream.Open
    mstream.Type = adTypeBinary
    mstream.LoadFromFile sFilePathAndName
    'add a new record and read our binary file into the OLE Field
    rs.AddNew
    rs.Fields("olepicturefield") = mstream.Read
    rs.Update
    'Edit: Removed some cleanup code I had inadvertently left here.

Cleanup:
    On Error Resume Next
    rs.Close
    mstream.Close
    Set mstream = Nothing
    Set rs = Nothing
    Set cn = Nothing
    Exit Function
ErrHandler:
    MsgBox "Error: " & Err.Number & " " & Err.Description
    LoadPicIntoDatabase = False
    Resume Cleanup
End Function

Private Sub Command0_Click()
    If IsNull(Me.txtFilePathAndName) = False Then
        If Dir(Me.txtFilePathAndName) <> "" Then
            If LoadPicIntoDatabase(Me.txtFilePathAndName) = True Then
                MsgBox Me.txtFilePathAndName & " was successfully loaded into the database."
            End If
        End If
    End If
End Sub

第1版：

根据您的请求，以下是查找/加载给定文章的图片的代码。为了保持一致性，我还更改了上面的表和字段名称，以更好地反映您的项目并匹配下面的代码。我测试了这个代码，它对我来说工作正常。

Private Sub Command1_Click()
    If IsNull(Me.txtArticleID) = False Then
        If DCount("articleid", "tblArticles", "articleid = " & Me.txtArticleID) = 1 Then
            Dim rs As DAO.Recordset, sSQL As String, sTempPicture As String
            sSQL = "SELECT * FROM tblArticles WHERE ArticleID = " & Me.txtArticleID
            Set rs = CurrentDb.OpenRecordset(sSQL)
            If Not (rs.EOF And rs.BOF) Then
                sTempPicture = "C:MyTempPicture.jpg"
                Call BlobToFile(sTempPicture, rs("olepicturefield"))
                If Dir(sTempPicture) <> "" Then
                    Me.imagecontrol1.Picture = sTempPicture
                End If
            End If
            rs.Close
            Set rs = Nothing
        Else
            MsgBox "Article Not Found"
        End If
    Else
        MsgBox "Please enter an article id"
    End If
End Sub
Private Function BlobToFile(strFile As String, ByRef Field As Object) As Long
    On Error GoTo BlobToFileError
    Dim nFileNum As Integer
    Dim abytData() As Byte
    BlobToFile = 0
    nFileNum = FreeFile
    Open strFile For Binary Access Write As nFileNum
    abytData = Field
    Put #nFileNum, , abytData
    BlobToFile = LOF(nFileNum)
BlobToFileExit:
    If nFileNum > 0 Then Close nFileNum
    Exit Function
BlobToFileError:
    MsgBox "Error " & Err.Number & ": " & Err.Description, vbCritical, _
           "Error writing file in BlobToFile"
    BlobToFile = 0
    Resume BlobToFileExit
End Function