使用Excel VBA向Access DB添加附件

Posted 2021-04-19

我一直在研究过去几个小时，没有找到解决方案。我想要做的是让用户从Excel填写用户表单并将数据提交给Access，但其中一个字段需要一个基本上是附件的屏幕截图。我一直在尝试两组代码（DAO和ADODB）。我可以使用ADODB连接轻松地向Access提交任何其他数据类型，但不能提供附件。以下是我的2个代码：

    Private Sub cmdSave_Click()

    Dim fd As FileDialog
    Set fd = Application.FileDialog(msoFileDialogOpen)
    With fd
        .AllowMultiSelect = False
        .Title = "Please select file to attach"
        If .Show = True Then
            SelectFile = .SelectedItems(1)
        Else
            Exit Sub
        End If
    End With
    Set fd = Nothing

Dim NewCon As DAO.Database
Dim RS As DAO.Recordset
Dim strFileName As String
Dim wrkAcc As Workspace

Set NewCon = OpenDatabase("C:Usersmy.userDocumentsDatabase1.accdb")
Set RS = OpenRecordset("REPORTS", dbOpenTable)

RS.Edit

RS.Fields("NAME").Value = Application.UserName
RS.Fields("DATE_REPORT").Value = Date
RS.Fields("CLAIM_TYPE").Value = "Fielda"
RS.Fields("CLIENT_NAME").Value = "Fieldb"
RS.Fields("ISSUE").Value = "Fieldc"
RS.Fields("REPORT_NUMBERS").Value = "Fieldd"
'RS.Fields("ATTACHMENTS").      (this is where I want to place the attachment)
RS.Fields("LOG_TIME").Value = Now

RS.Close
NewCon.Close

End Sub

这是ADODB：

Private Sub Image1_Click()


    Dim fd As FileDialog
    Set fd = Application.FileDialog(msoFileDialogOpen)
    With fd
        .AllowMultiSelect = False
        .Title = "Please select file to attach"
        If .Show = True Then
            SelectFile = .SelectedItems(1)
        Else
            Exit Sub
        End If
    End With
    Set fd = Nothing

        Dim NewCon As ADODB.Connection
        Set NewCon = New ADODB.Connection
        Dim Recordset As ADODB.Recordset
        Set Recordset = New ADODB.Recordset

        NewCon.Open "Provider=Microsoft.ace.oledb.12.0;Data Source=C:Usersmy.userDocumentsDatabase1.accdb"
        Recordset.Open "REPORTS", NewCon, adOpenDynamic, adLockOptimistic
        Recordset.AddNew

        Recordset.Fields(1).Value = Application.UserName
        Recordset.Fields(2).Value = Date
        Recordset.Fields(3).Value = "Fielda"
        Recordset.Fields(4).Value = "Fieldb"
        Recordset.Fields(5).Value = "Fieldc"
        Recordset.Fields(6).Value = "Fieldd"
'       Recordset.Fields(6) (this is where I want to place the attachment)
        Recordset.Fields(8).Value = Now

        Recordset.Update
        Recordset.Close
        NewCon.Close

        End Sub

答案

在我看来，DAO是最简单的附件工作方式。

附件字段实际上是一个子表，可以作为记录集打开。您可以像使用任何记录集一样使用该字段。 "FileData"字段在附件字段中存储文件的压缩版本。

您可以调用LoadFromFile方法将新文件加载到"FileData"字段，或调用SaveToFile方法将附件保存到磁盘。

该记录集中还有一些其他字段，例如文件名，当您使用LoadFromFile方法时会自动填充这些字段

需要进行一些更改。

值初始化需要使用DAO.Recordset2来支持附件：

Dim RS As DAO.Recordset2
Dim rsAttachments As DAO.Recordset2

赋值部分，使用内部记录集：

RS.Fields("REPORT_NUMBERS").Value = "Fieldd"
Set rsAttachments = RS.Fields("ATTACHMENTS").Value
rsAttachments.AddNew
rsAttachments.Fields("FileData").LoadFromFile SelectFile
rsAttachments.Update
rsAttachments.Close
RS.Fields("LOG_TIME").Value = Now