Database 通过MS Access中的VBA添加附件

我的一个表格如下

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

此窗体上的所有控件均未绑定

添加按钮后面的代码如下所示：

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

---

您可以从中使用以下引用

相关代码如下所示：

'  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 

---

您可以从中使用以下引用

相关代码如下所示：

'  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 

---

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

   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

---

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

   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

---

您是否考虑过添加路径而不是附件本身？您需要添加名称并将所有文件移动到一个集中的文件夹中进行观察，以便根据名称随时可以从该文件夹中提取文件，或者提供完整的路径字符串（允许有足够的长度）：-）如何在vba代码中使用此控件中的项？您是否考虑过添加路径而不是附件本身？您需要添加名称并将所有文件移动到一个集中的文件夹中进行观察，以便根据名称随时从该文件夹中提取文件，或者提供完整的路径字符串（允许有足够的长度）：-）如何在vba代码中使用此控件中的项？