在Access Form中上传图片,但将图片存储在数据库之外

时间:2014-12-03 03:02:22

标签: database vba ms-access ms-access-2010

我是这个数据库设计的新手。我已经阅读了很多,将图片存储在数据库中是毫无意义的,因此我正在寻找一个VBA代码,允许我上传"访问表单中的图片,但在将超链接写入Recordset中的图片时,将实际文件存储在DB外部。

我在网上找不到这样的东西。

2 个答案:

答案 0 :(得分:1)

在MS Access 2010中,只需将图像控件绑定到路径表即可。例如,我的表名为Pictures,包含以下条目。

PicturePath
Z:\Users\Fionnuala\Pictures\abc.png
Z:\Users\Fionnuala\Pictures\abc.jpg

我现在只需要在绑定到表格的图像上进行图像控制,将控制源设置为PicturePath,将显示图像。

您还可以分解子文件夹和名称的路径,例如\ Pictures \ abc.png,这样只需在VBA中完成一些工作,就可以根据子文件夹创建完整路径。

如果您愿意,可以使用附件数据类型并上传图像。

答案 1 :(得分:0)

我找到了我想做的事。

这会将附件放在数据库外部的spcecific文件夹中,然后将路径存储在表字段中。

Public Function SaveAttachments(strPath As String, ByVal strSQL As String, ByVal Table_Field_Picture_FILE As String, Optional strPattern As String = "*.*") As Long 'ByVal strSQL As String, ByVal Campo As String,
    Dim dbs As DAO.Database
    Dim rst As DAO.Recordset2
    Dim rsA As DAO.Recordset2
    Dim rsB As DAO.Recordset2
    Dim fld As DAO.Field2
    Dim strFullPath As String
    Dim qdf As DAO.QueryDef
    Dim prm As DAO.Parameter

    Set dbs = CurrentDb

    'strSQL = "SELECT * FROM SubFSolDesc WHERE NumeroSolicitud= " & Screen.ActiveForm.SolicitudID & ";"

    'Set rst = dbs.OpenRecordset("SubFSolDesc")
    Set rst = dbs.OpenRecordset(strSQL, dbOpenDynaset)
    Set fld = rst([Table_Field_Picture_FILE]) '"FotografiaProyecto") '

    'Navigate through the table
    Do While Not rst.EOF

        'Get the recordset for the Attachments field
        Set rsA = fld.value

        'Save all attachments in the field
        Do While Not rsA.EOF

            If rsA("FileName") Like strPattern Then
                strFullPath = strPath & "\" & rsA("FileName")
                Debug.Print strFullPath

                'Make sure the file does not exist and save
                If Dir(strFullPath) = "" Then
                    rsA("FileData").SaveToFile strFullPath

                End If

                'Increment the number of files saved
                SaveAttachments = SaveAttachments + 1

            End If

            'Next attachment
            rsA.Delete
            rsA.MoveNext
        Loop
        rsA.Close

                        With rst
                        .Edit
                        ![Desired_Path_Field] = strFullPath
                        .Update
                        End With
        'Next record
        rst.MoveNext
    Loop

    rst.Close
    dbs.Close

    Set fld = Nothing
    Set rsA = Nothing
    Set rst = Nothing
    Set dbs = Nothing
End Function