Looping through query of attachments

[ccondran08]

I have found the following code from a google search that will copy an attachment from a record to a file location. This serves the purpose of what i am trying to do, however I would like to make some modifications which i am struggling to solve. I would like to reference a query of the table instead of the table itself so i can put in some conditions in the query and then i would also like it to loop through the query so it will bulk save the records as it will only save one at a time at the moment. Thanks in advance.


On Error GoTo Err_SaveImage

Dim db As DAO.Database
Dim rsParent As DAO.Recordset2
Dim rsChild As DAO.Recordset2

Set db = CurrentDb
Set rsParent = Me.Recordset

rsParent.OpenRecordset

Set rsChild = rsParent.Fields("AttachmentTest").Value


rsChild.OpenRecordset
rsChild.Fields("FileData").SaveToFile ("C:\DB_Test")


Exit_SaveImage:

Set rsChild = Nothing
Set rsParent = Nothing
Exit Sub

Err_SaveImage:

If Err = 3839 Then
MsgBox ("File Already Exists in the Directory!")
Resume Next

Else
MsgBox "Some Other Error occured!", Err.Number, Err.Description
Resume Exit_SaveImage

End If

 

[arnelgp]

you would do the same with query.

Public Function SaveAttach(TableOrQueryName As String, AttachmentField As String, PathToSave As String)
' 
' parameters
'
' TableOrQueryName     the name of the query
' AttachmentField    the name of attachment field in the query
' PathToSave        the complete path where to save the attachments.
'
' example:
'
' Call SaveAttach("myQuery", "Pics", "D:\Folder\")
'
' Call SaveAttach("TableName", "Pics", "D:\Folder\")
'
Dim rsParent As dao.recordset2
dim rsChild As dao.recordset2
dim fld as dao.field2
dim strFileName As String

set rsparent = currentdb.openrecordset(TableOrQueryName, dbOpenSnapshot)
with rsparent
    if not (.bof and .eof) then .movefirst
    while not .eof
        set rsChild = rsParent(AttachmentField).Value
        if not (rschild.bof and rschild.eof) then rschild.movefirst
        while not rschild.eof
            set fld = rschild("FileData")
            strFileName= rschild("FileName")
            if dir(PathToSave & strFilename)<>"" Then Kill (PathToSave & strFileName)
            fld.SaveToFile PathToSave & strFileName
            rsChild.MoveNext
        Wend
        .MoveNext
    Wend
End With
set fld=nothing
set rsChild=nothing
set rsParent=nothing
End Function

 

[ccondran08]

Thanks for your reply arnelgp, i will give this a go.