如何从文件中创建 ole 对象 - Ms-access

Question

我有一个带有嵌入图片 (OLE) 列的表格。

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

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

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

谢谢， 指手画脚。

编辑：

好的，正如@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 连接对象来读取和写入二进制数据。您必须在 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