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

|| 我有一张带有嵌入式图片（OLE）库伦的表。 我希望能够通过带有浏览选项的表单插入新记录。 无论如何，我都有一个文件名，并且需要将其转换为ole对象并将其插入表单。如何在VBA中做到这一点？ 为了澄清-我需要将文件名转换为带有该文件的ole对象，然后将其插入表中。 谢谢， 手指人。 编辑： 好的，正如@HansUp指出的，我需要解释一下。 在我的表单中，我有一个绑定的OLE对象，该对象不绑定到字段，而是绑定到dlookup函数。我通过查询和组合框将正确的ID放入控件中-因此控制器绑定到： 
=DLookUp(\"picture\",\"articles\",\"id=\" & [articles])
请注意，文章不是字段，而是控制器，我不知道这是否有所不同。 每次更改控制器时，我都使用ѭ1，以便绑定的OLE可以更新其值。 无论如何，我想仅通过VBA和用户输入文件地址来执行此操作，而无需使用控制器，而是使用某种INSERT或其他方式，但是可以使用其他选项。 如果我不清楚，请询问！我会澄清并修正自己。 编辑2：   那么如何获取文件名或   派生出来的？您是否希望使用   ArticleID？图片总是在   预期的位置和预期的位置   文件名？你到底想要什么   如果不使用“浏览”按钮怎么办？   您是否正在全力寻找东西   基于文件夹和文件自动   名字或你在找什么   喜欢拖放吗？ 文件名是通过浏览选项获得的，我已提出要求。为了简单起见-假设用户必须在文本框中输入文件名。 现在-我想要单击按钮，就可以将该文件名作为嵌入式ole对象插入到数据库中。我既不寻求任何自动化也不希望拖放（但是，如果拖放有效，那就太好了）。自某人问起以来，第一次编辑是关于ole控制器的。他认为可以使用该控制器解决我的问题-因此我提供了有关如何显示图片的详细信息。我认为这没有任何意义，但如果有人可以使用，对我来说就可以了。我希望使用articleID进行更新-但同样，我看不到它与问题之间的关系。 我开始认为这可能是不可能的..... :( 这是不幸的，因为该问题相当直截了当。您有一个文件名，您需要将其作为OLE对象嵌入到数据库中。     
2020-02-01 2 条评论
分享

没有找到相关结果

    已邀请:

    骨乏唯瓜

    在提供答案之前，我将快速地重新措辞一下您的问题及其要求。在我看来，您希望能够使用VBA，表中的OLE对象字段和绑定对象框架加载二进制文件对象（在本例中为图片）。 最好的选择是停止尝试使用绑定的对象框架，因为它有太多限制。 对于您要尝试执行的操作，基本上有两种推荐的方法。 1）仅存储指向图像文件的链接，然后使用图像控件（可以将其绑定到您的图片字段）来显示图像。 2）使用代码将图像存储在OLE对象字段中，以将图像作为二进制数据读取。当需要显示图像时，需要将其写到临时文件中，然后可以将图像控件上的Picture属性设置为临时图像文件的完整路径和文件名。将图像文件作为临时文件来管理。您可以使用Windows的临时目录，也可以在每次需要显示图像时简单地写出相同的文件名。 这些技术都不是太困难。这里有一篇非常好的文章可以帮助您进一步了解我在说什么：http://www.jamiessoftware.tk/articles/handlingimages.html 这是一个用于读取二进制数据（在本例中为您的图片文件）的功能，以及另一个用于写入二进制数据的功能：http://www.ammara.com/access_image_faq/read_write_blob.html此功能非常适用于将图片写出到\“ temp \”文件。然后，您要做的就是将图像控件上的Picture属性设置为临时文件的文件路径和名称。 您还可以使用ADO Stream对象以及ADO RecordSet对象和ADO Connection对象来读写二进制数据。您必须在“访问Microsoft ActiveX数据对象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
    编辑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
        
    2020-02-01 0 0
    分享
    为什么被折叠? 0 个回复被折叠

    要回复问题请先登录或注册

    或代码 OrCode.com 备案号：粤ICP备15020848号-1
    Escape time: 0.058904886245728