Microsoft Access Team Blog : Attachment

Adding multiple attachments from a folder

James K. Rivera — Fri, 01 Aug 2008 00:55:00 GMT

Rob Cooper recently made a post, Adding Attachments from a Folder, which shows how to add a single attachment file per row. But what if you wanted to add more than one file? One (highly contrived) scenario would be to add all of the files in a folder to one row, and do so recursively if requested, similar to Rob's example.

What follows is some VBA code to do this, which borrows a bit from Rob's post and a bit from one of my earlier posts. However, I should point out this (again, highly contrived scenario) is meant only as an example and not something I would recommend doing, because if you are adding more than just a few files you can (ok, WILL) bloat your database very quickly, and in doing so can negatively impact performance and potentially hit the two gigabyte file size limit very quickly (see Access 2007 Specifications for details on database file size and object limitations).

First, to use the following sample code you will need to do some setup. Create a new table, add the following fields, and save it as Table1:

Table1

Field Name	Data Type
ID	Autonumber (Primary Key)
FolderPath	Text
Files	Attachment

Next, open the VBE window (ALT+F11) and insert a new module (Insert -> Module), and paste in the following code:


' ------------------------------------------------------------------------- 
' Procedure : StoreFilesInTable 
' Purpose   : Adds all files matching the specified file mask from the 
'           : specified folder to an attachment field. 
'           : Each row in the represents all files stored from the folder. 
' Arguments : strFolder - The path to the folder stored in the attachment field. 
'           : strTable  - The name of the table containing the attachment field. 
'           : strPathField - The name of the field for the archived folder. 
'           : strAttachmentField - The name of the attachment field. [Files] 
'           : strPattern - File mask. [*.*] 
'           : blnIncludeSubfolders - Recurse into subfolders. [False] 
'           : db1 - The database to operate on.  [CurrentDb] 
' Comments  : The db1 param is included so this can be used to store files in 
'           : a separate database, since using the attachment field this way 
'           : can quickly push a database beyond the 2gb file size limit. 
' ------------------------------------------------------------------------- 
Public Function StoreFilesInTable( _ 
                ByVal strFolder As String, _ 
                ByVal strTable As String, _ 
                ByVal strPathField As String, _ 
                Optional ByVal strAttachmentField As String = "Files", _ 
                Optional ByVal strPattern As String = "*.*", _ 
                Optional ByVal blnIncludeSubfolders As Boolean = False, _ 
                Optional ByRef db1 As DAO.Database) 
    Const CALLER = "StoreFilesInTable" 
    On Error GoTo StoreFilesInTable_ErrorHandler 
    Dim strFilePath As String 
    Dim rstParent   As DAO.Recordset2 
    Dim rstChild    As DAO.Recordset2 
    Dim fldAttach   As DAO.Field2 
    ' These objects require a reference to the "Microsoft Scripting Runtime" 
    ' but are defined as "Object" instead to use late binding and avoid that. 
    ' If you've added the reference, remove the "Object" and uncomment the 
    ' following lines to get the intellisense autocomplete for these objects. 
    Dim objFso       As Object ' Scripting.FileSystemObject 
    Dim objFolder    As Object ' Scripting.Folder 
    Dim objSubFolder As Object ' Scripting.Folder 
    Dim objFile      As Object ' Scripting.File 
    ' If the user did not specify a database, use the current one. 
    If db1 Is Nothing Then Set db1 = Application.CurrentDb 
    ' Instantiate the FileSystemObject. 
    Set objFso = CreateObject("Scripting.FileSystemObject") 
    ' Make sure the folder path always ends with a "\". 
    If (Right(strFolder, 1) <> "\") Then strFolder = strFolder & "\" 
    ' Make sure the folder exists. 
    If Not objFso.FolderExists(strFolder) Then 
        MsgBox "Folder does not exist: " & strFolder, _ 
        vbExclamation, CALLER 
        Exit Function 
    End If 
    ' It exists, so get the folder object. 
    Set objFolder = objFso.GetFolder(strFolder) 
    ' Open the table containing the attachment field 
    Set rstParent = db1.OpenRecordset(strTable) 
    rstParent.AddNew 
    rstParent.Fields(strPathField).Value = objFolder.Path 
    ' Get the first file in this directory. 
    strFilePath = Dir(strFolder & strPattern) 
    ' Store each file that meets the pattern 
    While (Len(strFilePath) > 0) 
        Set rstChild = rstParent.Fields(strAttachmentField).Value 
        rstChild.AddNew 
        Set fldAttach = rstChild.Fields("FileData") 
        fldAttach.LoadFromFile strFolder & strFilePath 
        rstChild.Update 
        rstChild.Close 
        strFilePath = Dir() ' Get the next file 
    Wend 
    ' Commit the new row with the attachments field populated 
    ' with all of the files from the current folder. 
    rstParent.Update 
    ' Recurse into subfolders if requested. 
    If (blnIncludeSubfolders) Then 
        For Each objSubFolder In objFolder.SubFolders 
            StoreFilesInTable objSubFolder.Path, strTable, _ 
                              strPathField, strAttachmentField, _ 
                              strPattern, blnIncludeSubfolders, db1 
        Next 
    End If 
Cleanup: 
    rstParent.Close 
    Set rstParent = Nothing 
    Exit Function 
StoreFilesInTable_ErrorHandler: 
    Debug.Print "Error # " & Err.Number & " in " & CALLER & " : " & Err.Description 
    MsgBox Err.Description, vbCritical, "Error # " & Err.Number & " in " & CALLER 
    GoTo Cleanup 
End Function 'StoreFilesInTable

Here is a short routine to help you test the above code. You will need to change the "<YourUserName>" to your login name, or just change the whole path in the strRootFolder string constant to the folder you want to store in the table. Note that I've set the blnIncludeSubfolders parameter to False to keep you from inadvertently bloating your database, but you can set it to True if you want to include all of the subfolders, too.


Sub TestStoreFilesInTable() 
    Const strRootFolder As String = "C:\Users\<YourUserName>\Pictures\" 
    StoreFilesInTable strRootFolder, "Table1", "FolderPath", "Files", "*.jpg", False 
    MsgBox "Done adding files from: " & vbCrLf & strRootFolder & "*.jpg", _ 
        VbMsgBoxStyle.vbInformation, "TestStoreFilesInTable" 
End Sub

Adding Attachments from a Folder

robcooper — Sat, 26 Jul 2008 05:40:00 GMT

Someone asked us yesterday how to add all of the .jpg files from a folder into an Attachment field in a table. In this case, the individual wanted to add one attachment into a new record in the table. This could be pretty useful, so we thought we would post it more broadly.

This code accepts parameters for the folder name, table name containing the attachment, the name of the attachment field, and two optional arguments. The first optional argument is a pattern that can be used when searching a directory, such as "*.*". The second optional argument is a flag to indicate whether to iterate through subfolders. This argument is False by default. The code uses the FileSystemObject which is required on the machine. We're using it late bound so a reference to the Microsoft Scripting Runtime is not required.

Next, add the following routine to the module.

' -------------------------------------------------------------------------
' Procedure : AddAttachmentsFromFolder
' Purpose   : Adds one record to an attachment field for each file in the
'           : specified folder.
' Arguments : strFolder - Name of the folder
'           : strTable   - Name of the table containing the attachment field
'           : strField   - Name of the attachment field
'           : strPattern - Search pattern for the directory. Defaults to
'           :              all files (*.*)
'           : fIncludeSubfolders - Include subfolders in the specified folder
'           :              Defaults to False
' Comments : This routine adds a new record to the table, then one attachment.
'           : It commits the changes and handles all cleanup
' -------------------------------------------------------------------------
Sub AddAttachmentsFromFolder(ByVal strFolder As String, _
                             ByVal strTable As String, _
                             ByVal strField As String, _
                             Optional ByVal strPattern As String = "*.*", _
                             Optional ByVal fIncludeSubfolders As Boolean = False)

    Dim strFile      As String
    Dim lngCount     As Long
    Dim rstParent    As DAO.Recordset2
    Dim rstChild     As DAO.Recordset
    Dim fldAttach    As DAO.Field2
    Dim objFso       As Object ' Scripting.FileSystemObject
    Dim objFolder    As Object ' Scripting.Folder
    Dim objFile      As Object ' Scripting.File
    Dim objSubFolder As Object ' Scripting.Folder

    On Error GoTo ErrorHandler
    ' Instantiate the FileSystemObject
    Set objFso = CreateObject("Scripting.FileSystemObject")

    ' fix up the folder
    If (Right(strFolder, 1) <> "\") Then strFolder = strFolder & "\"

    ' make sure the folder exists
    If (Dir(strFolder, vbDirectory) = "") Then
        MsgBox "The specified folder does not exist: " & strFolder, vbExclamation
        Exit Sub
    End If

    ' get the folder object
    Set objFolder = objFso.GetFolder(strFolder)

    ' open the table containing the attachment field
    Set rstParent = CurrentDb().OpenRecordset(strTable)

    ' get the first file
    strFile = Dir(strFolder & strPattern)

    ' get each file that meets the pattern
    While (Len(strFile) > 0)
        ' add a record to the parent table
        Debug.Print strFolder & strFile
        rstParent.AddNew

        ' get the attachment recordset and FileData field to contain the file
        Set rstChild = rstParent.Fields(strField).Value
        Set fldAttach = rstChild.Fields("FileData")

        ' add the attachment to the attachment field
        rstChild.AddNew
        fldAttach.LoadFromFile strFolder & strFile
        rstChild.Update
        rstParent.Update

        ' get the next file
        strFile = Dir
    Wend

    ' recurse subfolders?
    If (fIncludeSubfolders) Then
        For Each objSubFolder In objFolder.SubFolders
            AddAttachmentsFromFolder objSubFolder.Path, strTable, strField, _
                                     strPattern, fIncludeSubfolders
        Next
    End If

Cleanup:
    rstParent.Close
    Set rstParent = Nothing
    Exit Sub

ErrorHandler:
    Debug.Print "Error " & Err.Number & " - " & Err.Description
    MsgBox Err.Description & vbCrLf & _
           Err.Number & vbCrLf & _
           Err.Source, VbMsgBoxStyle.vbCritical, "AddAttachmentsFromFolder Failed"
    GoTo Cleanup
End Sub

To test the routine, supply the name of a folder, as well as the name of a table and field. Here's a wrapper routine that does this. This example will load all .jpg files in the specified directory into a table called tblMyTable.

Sub TestAddAttachmentsFromFolder()
    Const strRootFolder As String = "<EnterFolderName>"
    AddAttachmentsFromFolder strRootFolder, "tblMyTable", "Attachments", _
        "*.jpg", True
    MsgBox "Done adding files from: " & vbCrLf & strRootFolder, _
        vbInformation, "File Import Process Completed"
End Sub

Using VBA code to open a file stored in the new Access 2007 Attachment field

James K. Rivera — Thu, 30 Aug 2007 20:30:00 GMT

Someone asked me about using the Attachment data type in Access 2007 for a specific task. They wanted to use it as a simple data type where it would only be used to hold 1 file per record, and they wanted to be able to open the file in an external application using a button on a form instead of using the Attachment control on a form. Given these constraints, I was created a simple VBA function for doing just that:

Public Function OpenFirstAttachmentAsTempFile(ByRef rstCurrent As DAO.Recordset, ByVal strFieldName As String) As String 

    Dim rstChild As DAO.Recordset2
    Dim fldAttach As DAO.Field2
    Dim strFilePath As String
    Dim strTempDir As String

    strTempDir = Environ("Temp") ' Get the Temp directory from the environment variable.
    If Right(strTempDir, 1) <> "\" Then strTempDir = strTempDir & "\" ' Make sure the path always ends with a backslash.
        Set rstChild = rstCurrent.Fields(strFieldName).Value ' the .Value for a complex field returns the underlying recordset.
        strFilePath = strTempDir & rstChild.Fields("FileName").Value ' Append the name of the first (and only) attached file to temp dir.
        If Dir(strFilePath) <> "" Then ' the file already exists--delete it first.
        VBA.SetAttr strFilePath, vbNormal ' remove any file attributes (e.g. read-only) that would block the kill command.
        VBA.Kill strFilePath ' delete the file.
    End If

    Set fldAttach = rstChild.Fields("FileData") ' The binary data of the file.
    fldAttach.SaveToFile strFilePath
    rstChild.Close ' cleanup
    VBA.Shell "Explorer.exe " & Chr(34) & strFilePath & Chr(34), vbNormalFocus ' Use Windows Explorer to launch  the file.

End Function 'OpenFirstAttachmentAsTempFile

Then I wrote this function just to test it in a database that has a Table1 with an Attachment field named "Files" in which I had already placed a file:

Public Function TestOpenFirstAttachmentAsTempFile()
    Dim dbs As DAO.Database
    Dim rst As DAO.Recordset
    
    Const strTable = "Table1"
    Const strField = "Files" ' Attachment field in Table1

    Set dbs = CurrentDb
    Set rst = dbs.OpenRecordset(strTable)
    'rst.MoveNext ' Uncomment this line to go to the 2nd row in the Table.
    OpenFirstAttachmentAsTempFile rst, strField
    rst.Close
End Function

By using the VBA.Shell command with Explorer.exe, the file will be opened just as if you double clicked it from Windows Explorer!

See my previous blog post about attachments for more information about accessing attachments from DAO.

Adding, removing, and saving files from the new Attachment field in Access 2007

James K. Rivera — Fri, 24 Aug 2007 23:41:00 GMT

One of the coolest new features in Access 2007 is the new Attachments data type. There are some very helpful dialogs for working with this data type, but there are also some useful additions to DAO to make automating the process of adding and saving attachments easy, too. What follows is some VBA code I've written that I hope you will find useful in understanding how do to this.

First, let's look at the code to get a file into a table using DAO:

The AddAttachment sub takes a reference to a DAO.Recordset for the table or query with the attachment field, the name of the attachment field, and the full path to the file to be attached. The easiest way to use this is to call Database.OpenRecordset and pass in the name of the table. Then, before calling this sub, call Recordset.AddNew or Recordset.Edit to allow changes to the Recordset (this sets Recordset.Updatable = True). After this sub returns, you must call Recordset.Update to commit the changes.


' Module level constants used in these examples
Const m_strFieldFileName As String = "FileName" ' The name of the attached file
Const m_strFieldFileType As String = "FileType" ' The attached file's extension
Const m_strFieldFileData As String = "FileData" ' The binary data of the file

' -------------------------------------------------------------------------
' Sub/Func : AddAttachment
' Purpose  : Saves the attachments at the current row of the open Recordset
' Arguments: rstCurrent - The recordset open at the current row to save
'          : strFieldName - The name of the attachment field
'          : strFilePath - The full path to the file to attach
' Comments : User must call .AddNew or .Edit on the incoming Recordset
'          : and then Recordset.Update when this returns to commit changes
' -------------------------------------------------------------------------
Sub AddAttachment(ByRef rstCurrent As DAO.Recordset, ByVal strFieldName As String, ByVal strFilePath As String)
    Const CALLER = "AddAttachment"
    On Error GoTo AddAttachment_ErrorHandler

    Dim rstChild  As DAO.Recordset2
    Dim fldAttach As DAO.Field2

    If Dir(strFilePath) = "" Then ' the specified file does not exist!
        MsgBox "The specified input file does not exist: " & vbCrLf & strFilePath, vbCritical, "File not found"
        Exit Sub
    End If

    Set rstChild = rstCurrent.Fields(strFieldName).Value ' the .Value for a complex field returns the underlying Recordset.
    rstChild.AddNew ' add a new row to the child Recordset
    Set fldAttach = rstChild.Fields(m_strFieldFileData) ' set the DAO.Field2 object to the field that holds the binary data.
    fldAttach.LoadFromFile strFilePath ' store the file's contents in the new row.
    rstChild.Update ' commit the new row.
    rstChild.Close ' close the child Recordset.

    Exit Sub
AddAttachment_ErrorHandler:
    'Check for Run-time error '3820': (occurs if the file with the same name is already attached)
    'You cannot enter that value because it duplicates an existing value in the multi-valued lookup or attachment field.
    'Multi-valued lookup or attachment fields cannot contain duplicate values.
    Debug.Print "Error # " & Err.Number & " in " & CALLER & " : " & Err.Description
    If Err.Number <> 3820 Then
        MsgBox Err.Description, VbMsgBoxStyle.vbCritical, "Error # " & Err.Number & " in " & CALLER
        Debug.Assert False ' always stop here when debugging
    Else
        MsgBox "File of same name already attached", VbMsgBoxStyle.vbCritical, "Cannot attach file"
    End If
    Exit Sub
End Sub 'AddAttachment

Next, the following code will save all of the files in the attachment field of the current row. This sub takes similar parameters: the Recordset object, the name the of the attachment field, and the directory to place all of the attachments for the field in the current row. However, since the Recordset is not being modified, it is not necessary to call Recordset.Edit (or AddNew) before calling this sub.

' -------------------------------------------------------------------------
' Sub/Func : SaveAttachments
' Purpose  : Saves the attachments at the current row of the open Recordset
' Arguments: rstCurrent - The recordset open at the current row to save
'          : strFieldName - The name of the attachment field
'          : strOutputDir - The folder to put the files in (e.g. "C:\Foo\")
' -------------------------------------------------------------------------
Sub SaveAttachments(ByRef rstCurrent As DAO.Recordset, ByVal strFieldName As String, ByVal strOutputDir As String)
    Const CALLER = "SaveAttachments"
    On Error GoTo SaveAttachments_ErrorHandler

    Dim rstChild As DAO.Recordset2
    Dim fldAttach As DAO.Field2
    Dim strFilePath As String

    If Right(strOutputDir, 1) <> "\" Then strOutputDir = strOutputDir & "\"
    Set rstChild = rstCurrent.Fields(strFieldName).Value ' The .Value for a complex field returns the underlying Recordset.
    While Not rstChild.EOF ' Loop through all of the attached files in the child Recordset.
        strFilePath = strOutputDir & rstChild.Fields(m_strFieldFileName).Value 'Append the name of the attached file to output directory.
        If Dir(strFilePath) <> "" Then ' The file already exists--delete it first.
            VBA.SetAttr strFilePath, vbNormal ' Remove any flags (e.g. read-only) that would block the kill command.
            VBA.Kill strFilePath ' Delete the file.
        End If
        Set fldAttach = rstChild.Fields(m_strFieldFileData) ' The binary data of the file.
        fldAttach.SaveToFile strFilePath
        rstChild.MoveNext ' Go to the next row in the child Recordset to get the next attached file.
    Wend
    rstChild.Close ' cleanup

    Exit Sub
SaveAttachments_ErrorHandler:
    Debug.Print "Error # " & Err.Number & " in " & CALLER & " : " & Err.Description
    MsgBox Err.Description, VbMsgBoxStyle.vbCritical, "Error # " & Err.Number & " in " & CALLER
    Debug.Assert False ' always stop here when debugging
    Resume Next
End Sub 'SaveAttachments

Next, you might want to be able to remove a file from the attachment field of the current row. This sub takes similar parameters: the Recordset object, the name the of the attachment field, and the name of the file in the attachments field in the current row to be removed. Since the Recordset is being modified, before calling this sub, you must call Recordset.Edit (or Recordset.AddNew) to allow changes to the Recordset (this sets Recordset.Updatable = True). After this sub returns, you must call Recordset.Update to commit the changes.

' -------------------------------------------------------------------------
' Sub/Func : RemoveAttachment
' Purpose  : Removes the file from the attachments field in the currect row
' Arguments: rstCurrent - The recordset open at the current row to change
'          : strFieldName - The name of the attachment field
'          : strFileName - The name of the file to remove
' Comments : User must call .AddNew or .Edit on the incoming Recordset
'          : and then Recordset.Update when this returns to commit changes
' -------------------------------------------------------------------------
Sub RemoveAttachment(ByRef rstCurrent As DAO.Recordset, ByVal strFieldName As String, ByVal strFileName As String)
    Const CALLER = "RemoveAttachment"
    On Error GoTo RemoveAttachment_ErrorHandler

    Dim rstChild As DAO.Recordset2
    Dim fldAttach As DAO.Field2
    Dim strCurrent As String
    Dim strChop() As String

    Debug.Print "Parent row (ID) is: " & rstCurrent.Fields("ID").Value
    strChop = Split(strFileName, "\") ' This chops the file name up into into an array of strings delimited by "\".
    strFileName = UCase(strChop(UBound(strChop))) ' The last element in the returned array is the filename.
    Set rstChild = rstCurrent.Fields(strFieldName).Value ' the .Value for a complex field returns the underlying Recordset.
    While Not rstChild.EOF ' Loop through all of the attached files in the child Recordset.
        strCurrent = rstChild.Fields(m_strFieldFileName) ' The name of the file in the current row of the child Recordset.
        If UCase(strCurrent) = strFileName Then ' we found the attachment to be removed--delete it.
            rstChild.Delete ' There is no need to call rstChild.Edit first because the parent Recordset is in Edit mode.
            rstChild.Close
            Exit Sub ' We're done removing the file.
        End If
        rstChild.MoveNext ' The file to remove was not the current one--move to the next row of the child Recordset.
    Wend
    rstChild.Close ' cleanup

    Exit Sub
RemoveAttachment_ErrorHandler:
    Debug.Print "Error # " & Err.Number & " in " & CALLER & " : " & Err.Description
    Debug.Assert False ' always stop here when debugging
    MsgBox Err.Description, VbMsgBoxStyle.vbCritical, "Error # " & Err.Number & " in " & CALLER
    Resume Next
End Sub 'RemoveAttachment

Finally, some sample code to test these subs would be useful. Create a database with a Table1 consisting of an Autonumber primary key field named, "ID" and an Attachment field named, "Files". Then add the following code to a module along with the above methods and press F5 to run it or F8 to single step through it.

' -------------------------------------------------------------------------
' Sub/Func : TestAddRemoveAndSave
' Purpose : Test AddAttachment(), RemoveAttachment(), and SaveAttachments()
' -------------------------------------------------------------------------
Sub TestAddRemoveAndSave()
    Dim dbs As DAO.Database
    Dim rst As DAO.Recordset

    Const strTable = "Table1"
    Const strField = "Files" ' Attachment field in Table1

    Set dbs = CurrentDb
    Set rst = dbs.OpenRecordset(strTable)

    ' Add a new row and an attachment
    rst.AddNew
    AddAttachment rst, strField, "C:\Windows\Media\chimes.wav"
    rst.Update
    rst.MoveLast

    ' Add another attachment to the last row
    rst.Edit
    AddAttachment rst, strField, "C:\Windows\Media\chord.wav"
    rst.Update

    ' Remove the first attachment from the last row
    rst.Edit
    RemoveAttachment rst, strField, "chimes.wav"
    rst.Update

    If Dir("C:\Foo\", vbDirectory) = "" Then MkDir "C:\Foo"
    SaveAttachments rst, strField, "C:\Foo\"
    rst.Close
End Sub 'TestAddRemoveAndSave

And there you have it. I hope this code helps you in adding, removing, and saving attachments in Access!