how to export attachments stored in Access

[edg126]

I have an access database with many records with an attachment field that contains multiple document attachments. I'm trying to find stock code that loops through each record and exports all of the files into a directory on my hard drive. Has anyone done this before? It seems to me this would be a common task...

Thanks!
-Ed

[edg126]

It's buggy, but here was some code I'm working off of to perform this task, which should work.

http://www.access-programmers.co.uk/forums/showthread.php?t=194709

[edg126]

The one thing I'd like to do is append the ID field of the database to the filename to prevent the duplicate filename error that appears at the bottom. Can anyone give suggestions on how to do this?



Option Compare Database
Private Sub Command5_Click()
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
With rsParent
.MoveFirst 'This ensures that regardless of your current record, the loop will start with the first record
Do While Not .EOF

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

With rsChild
Do While Not .EOF
If rsChild.RecordCount <> 0 Then
rsChild.OpenRecordset
rsChild.Fields("FileData").SaveToFile ("C:\Documents and Settings\ec\My Documents\Work\2012-12_db_export\test3")

rsChild.Delete
Me.Refresh

.MoveNext
Else
.MoveNext
End If

Loop
.Close
' MsgBox "Record cw"
End With
.MoveNext
Loop
.Close
'MsgBox "Recordset cw"
End With
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 "There's been an error!", Err.Number, Err.Description
Resume Exit_SaveImage
End If
End Sub