Search code examples
vbams-accessattachment-field

VBA Attachment: Item Not found in Collection


All,

I'm trying to save a record for 1 record to a drive. I've spent about a day searching for a solution so this is a last ditch effort for some help. I am not a developer by any stretch of the imagination so please, go easy.

Code is below.

Table where record is located: tracker.

Field I am searching based on: ReqID - where ReqID = the record I am entering, find the attachment and move it to a location.

Dim db As DAO.Database
Dim rsChild As DAO.Recordset2
Dim ReqID As String

ReqID = Me.Form![Text145]
Debug.Print ReqID

Set db = CurrentDb
Set rsChild = db.OpenRecordset("Select * from tracker Where " & ReqID & " = [tracker].[ID]", dbOpenDynaset)
Debug.Print rsChild.RecordCount



   If (rsChild.EOF = False) Or (rsChild.BOF = False) Then

    While Not rsChild.EOF
rsChild("FileData").SaveToFile "C:\Users\<folder>\"
        rsChild.Delete
    Wend
    End If

Solution

  • You actually need to use two Recordset objects: one for the main record and another for the attachment(s) associated with that record. This is the sample code that works for me, where [tblTest] is the name of the table and [Attachments] is the name of the Attachment field:

    Option Compare Database
    Option Explicit
    
    Sub SaveAllAttachments()
        Dim cdb As DAO.Database
        Set cdb = CurrentDb
        Dim rstMain As DAO.Recordset
        Set rstMain = cdb.OpenRecordset("SELECT Attachments FROM tblTest WHERE ID=1", dbOpenDynaset)
        rstMain.Edit
        Dim rstChild As DAO.Recordset2
        Set rstChild = rstMain.Fields("Attachments").Value
        Do Until rstChild.EOF
            Dim fileName As String
            fileName = rstChild.Fields("FileName").Value
            Debug.Print fileName
            Dim fld As DAO.Field2
            Set fld = rstChild.Fields("FileData")
            fld.SaveToFile "C:\Users\Gord\Desktop\" & fileName
            rstChild.Delete  ' remove the attachment
            rstChild.MoveNext
        Loop
        rstChild.Close
        rstMain.Update
        rstMain.Close
    End Sub