Unfiltered HTML
Unfiltered HTML

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

by
on August 24
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!
Tags:
, ,

Office Blogs Comments

Comments: (5) Collapse

  • Oli-S
    14,915 Posts

    Somewhat similar content with a more step by step approach in this tutorial on my site (if anyone is interested): www.access-freak.com/tutorials.html

    24 Aug 2007
  • AEAIJ
    14,915 Posts

    Just curious, do you save VBA code snippets in a library on-line?

    26 Aug 2007
  • Zac Woodall
    14,915 Posts

    AEAIJ, do you mean other than here? Did you notice the 'code' tag on the blog? If you filter to that you should be able to search all the code snippets the Access team has published here.

    27 Aug 2007
  • Gilad
    14,915 Posts

    I read that the email forms will enable access to extract the information from a returned email and insert it automatically into the access database in the appropriate tables. Will this also include the attachments added to this email form? Will it be possible to automatically insert them in the attachment field of a given table? Thanks

    29 Aug 2007
  • Zac Woodall
    14,915 Posts

    Sorry Gilad, in 2007 our email data collection feature doesn't yet have support for attachments.

    29 Aug 2007
Comments

Comments: (loading) Collapse