Access.2007.VBA.Bibl..

collection of a record and saves each one to a file in the Output Documents folder selected on the
main menu:

Public Function SaveAttachments()

On Error GoTo ErrorHandler

Dim intSpace As Integer

Dim strTest As String

Dim strSearch As String

strDocsPath = GetOutputDocsPath()

Debug.Print “Output docs path: “ & strDocsPath

Set fso = CreateObject(“Scripting.FileSystemObject”)

Set fld = fso.GetFolder(strDocsPath)

Set dbs = CurrentDb

Set rstTable = dbs.OpenRecordset(“tblContacts”)

Do While Not rstTable.EOF

Create recordset of attachments for this record.

Set rstAttachments =
rstTable.Fields(“File”).Value
With rstAttachments
Do While Not .EOF
strFileAndPath = strDocsPath
& .Fields(“FileName”)
Save this attachment to a file in the Output Docs folder.

Debug.Print “Saving “ & strFileAndPath _

& “ to “ & strDocsPath & “ folder”

Turn off error handler to prevent errors if the file already exists in the folder.

On Error Resume Next

.Fields(“FileData”).SaveToFile strFileAndPath

.MoveNext

Loop

.Close

End With

rstTable.MoveNext

Loop

rstTable.Close

strPrompt = “All new attachments saved to “ _

& strDocsPath & “ folder”

strTitle = “Done!”

MsgBox strPrompt, vbOKOnly + vbInformation, strTitle

Working with Files and Folders 9