database - 在 MS Access 中通过 VBA 添加附件

Question

我的一种形式如下

这是在 MS Access 中制作的表格，允许我的用户添加观察结果。观察可能包括如图所示的附件。我可以单击附件控件并将附件添加到弹出的弹出窗口中。但是，可以预期的是，当我单击如上表所示的添加按钮时，该附件应添加到表格的相应字段中。

此表单上的所有控件均未绑定。

ADD按钮后面写的代码如下：

Private Sub cmdAdd_Click()
    Dim db As DAO.Database
    Dim rs As DAO.Recordset

    Set db = CurrentDb
    Set rs = db.OpenRecordset("tblObservation", dbOpenDynaset)

    rs.AddNew

    rs![Artifact] = artifactId
    rs![Observation Text] = txtObservationText.Value

    'rs![Attachments] = ' not able to solve this

    rs.Update
    rs.Close

    Set rs = Nothing
    Set db = Nothing
End Sub

Answer 1

您可以使用Microsoft的以下参考

相关的代码是这样的：

'  Instantiate the parent recordset.  
Set rsEmployees = db.OpenRecordset("Employees") 

'… Code to move to desired employee 

' Activate edit mode. 
rsEmployees.Edit 

' Instantiate the child recordset. 
Set rsPictures = rsEmployees.Fields("Pictures").Value  

' Add a new attachment. 
rsPictures.AddNew 
rsPictures.Fields("FileData").LoadFromFile "EmpPhoto39392.jpg" 
rsPictures.Update 

' Update the parent record 
rsEmployees.Update 

Answer 2

首先，将附件控件绑定到所需表的附件字段

   Private Sub cmdAdd_Click()
           'Me.Dirty = False  'fix Error 3188 is Could not update...
            Dim db As DAO.Database
            Dim rs As DAO.Recordset
            Dim rsFiles As DAO.RecordSet2
        
            Set db = CurrentDb
            'Create a DAO Recordset from a table in the current database
            Set rs = db.OpenRecordset("tblObservation")
                           
            rs.AddNew
            rs![Artifact] = artifactId
            rs![Observation Text] = txtObservationText.Value        
    
            Set rsFiles = rs.Fields("Attachments").Value 
            'This is a piece of code to get multiple files
            For i = 0 To AttachmentControl.AttachmentCount-1
                rsFiles.AddNew
                'Attachment control is used as an uploader file 
                rsFiles.Fields("FileData").LoadFromFile  AttachmentControl.FileName(i)
            Next i
        
            rsFiles.Update 
            rsFiles.Close
        
            rs.Update
            rs.Close
        
            Set rs = Nothing
            Set db = Nothing
        End Sub