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

我有一张带有嵌入式图片（OLE）coulmn的桌子

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

无论如何，我有一个文件名，我需要将其转换为ole对象并将其插入表单中。如何在VBA中实现这一点

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

谢谢， 芬格曼

编辑：

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

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

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

每次更改控制器时，我都使用

me.recalc

，以便绑定的OLE可以更新其值

无论如何，我想通过VBA和用户输入一个文件地址就可以做到这一点，不需要使用控制器，而是使用某种插入或其他方式，但也欢迎使用其他选项

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

编辑2：

---

那么，文件名是如何获得的呢 衍生的？您是否希望使用 ArticleID？这幅画总是在同一个位置吗 预期的位置与预期的 文件名？你到底想干什么 如果不使用“浏览”按钮，您会怎么做？ 你在找什么东西吗 基于文件夹和文件的自动化 你在找什么吗 比如拖放

文件名是通过浏览选项获得的，我已经实现了。为了简单起见，假设用户必须自己在文本框中输入文件名。 现在，我希望只需单击一个按钮，就可以将该文件名作为嵌入式ole对象插入到我的数据库中。我不寻求任何自动化或拖放（但是，如果拖放有效，那就太好了）。第一次编辑是关于ole控制器的，因为有人问。他认为我的问题可以用那个控制器来解决，所以我详细说明了我是如何处理这张照片的。我不认为这有任何关系，但如果有人可以使用它，我会很好。我希望在更新中使用articleID，但我不知道这与这个问题有什么关系

我开始认为这可能是不可能的(

---

这是不幸的，因为这个问题非常严重。你有一个文件名，你需要在数据库中将它作为OLE对象进行修改。

在提供我的答案之前，我将快速地重新表述你的问题及其要求。我觉得你好像想加载二进制文件对象，我想在本例中，使用VBA、表中的OLE对象字段和绑定对象框进行图片处理

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

基本上，有两种推荐的方法可以帮助您完成任务

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

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

这两种技术都不太难。这里有一篇非常好的文章可以帮助您进一步理解我所说的内容：

这里有一个读取二进制数据的函数（在本例中为图片文件）和另一个写入二进制数据的函数：这对于将图片写入“temp”文件非常有效。然后，您只需将图像控件上的Picture属性设置为临时文件的文件路径和名称

您还可以使用ADO流对象、ADO记录集对象和ADO连接对象读取和写入二进制数据。您必须在访问Microsoft ActiveX Data Objects 2.8库时设置引用

下面是一些使用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

Private函数将picinto数据库（sFilePathAndName作为字符串）加载为布尔值
关于错误转到错误处理程序
'测试该文件是否存在。如果没有，请退出。
如果Dir（sFilePathAndName）=“”，则退出函数
LoadPicIntoDatabase=True
'创建连接对象
Dim cn作为ADODB.Connection
设置cn=CurrentProject.Connection
'创建其他变量
将rs设置为ADODB.Recordset
将mstream设置为ADODB.Stream
Set rs=New ADODB.Recordset
'配置记录集变量并仅打开1条记录（如果存在）
用rs
.LockType=adlockType
.CursorLocation=adUseClient
.CursorType=adOpenDynamic
.打开“从tblArticles中选择顶部1*”，cn
以
'打开二进制流对象并将文件加载到其中
设置mstream=New ADODB.Stream
mstream，打开
mstream.Type=adTypeBinary
mstream.LoadFromFile sFilePathAndName
'添加新记录并将二进制文件读入OLE字段
艾德纽卢比
rs.Fields（“olepicturefield”）=mstream.Read
rs.更新
'编辑：删除了我不小心留在这里的一些清理代码。
清理：
出错时继续下一步
rs.Close
mstream，关闭
设置mstream=Nothing
设置rs=无
设置cn=Nothing
退出功能
错误处理程序：
MsgBox“Error:”&错误号&“”&错误说明
LoadPicIntoDatabase=False
恢复清理
端函数
专用子命令0_单击（）
如果IsNull（Me.txtFilePathAndName）=False，则
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