Question

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

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

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

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

谢谢， Fingerman。

编辑：

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

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

请注意，文章不是字段而是控制器，我不知道是否存在任何差异。

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

无论如何，我认为这只是由VBA和用户输入文件地址，而不使用控制器但是某种INSERT或某种东西，但其他选项将是受欢迎的。

如果我不清楚，请问！我会澄清并修复自己。

编辑2：

那么如何获取文件名或得到的？你期待使用吗？条款ArticleID？图片总是在预期的位置与预期文件名？你到底想要什么？如果你不使用浏览按钮怎么办？你在寻找什么吗？基于文件夹和文件自动化你正在寻找什么名字喜欢拖放？

通过浏览选项获取文件名，我实现了它。为了简单起见 - 假设用户必须自己将文件名输入到文本框中。现在 - 我希望通过单击按钮，我可以将该文件名作为嵌入式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 Microsoft Office 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

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

1 个答案: