Solved

how do I copy an attachment to another table in MS Access 2013

Posted on 2014-09-25
4
454 Views
Last Modified: 2014-12-18
I need to copy an attachment to an attachment field in another table.  How do I do this?
0
Comment
Question by:peyton18
  • 2
4 Comments
 
LVL 74

Expert Comment

by:Jeffrey Coachman
Comment Utility
This may not be an easy thing to do.
You also did not specify any criteria for the copy.

So here, to simplify things, is some sample code to do what you have asked specifically:
copy an attachment to an attachment field in another table
You can see from this code that if you need specific "criteria" for the copy, ...the code will probably need to get a lot more complicated.

This basic code is based on the code provided in this link:
http://msdn.microsoft.com/en-us/library/office/ff191852%28v=office.15%29.aspx
Dim rsSource As DAO.Recordset
Dim rsDest As DAO.Recordset
Dim rsPictures As DAO.Recordset
Dim strPath As String

'Path to save the file
strPath = "C:\temp\temp.png"

'Brute force way to avoid the "file already exists" error
', ...so you will have to add your own standard error handling on your own
On Error Resume Next

'  Instantiate the parent recordset.
   Set rsSource = CurrentDb.OpenRecordset("tblSource")
   Set rsDest = CurrentDb.OpenRecordset("tblDest")
  ' … Code to export to desired attachment
  
   ' Instantiate the child recordset.
   Set rsPictures = rsSource.Fields("Att1").Value
 
   '  Loop through the attachments.
   While Not rsPictures.EOF
  
      '  Save current attachment to disk in the "My Documents" folder.
      rsPictures.Fields("FileData").SaveToFile strPath
      rsPictures.MoveNext
   Wend
   

'Code to insert the image
    ' Activate edit mode.
   rsDest.Edit

   ' Instantiate the child recordset.
   Set rsPictures = rsDest.Fields("Att2").Value

   ' Add a new attachment.
   rsPictures.AddNew
   rsPictures.Fields("FileData").LoadFromFile strPath
   rsPictures.Update

   ' Update the parent record
   rsDest.Update
   
rsSource.Close
rsPictures.Close
rsDest.Close
Set rsSource = Nothing
Set rsPictures = Nothing
Set rsDest = Nothing

Open in new window


I have attached the sample db I tested it on as well.

Study the code carefully, then make the needed adjustments to test this in your system

JeffCoachman
Access--EEQ---28525596-Copy-attachment-d
0
 
LVL 31

Accepted Solution

by:
Helen_Feddema earned 500 total points
Comment Utility
If it is stored in the new Attachment type field (Access 2007 and up), you can use the procedures listed below to save the attachment from one table, and then put it into another table.
Public Function LoadAttachments()
'Created by Helen Feddema 24-Feb-2009
'Last modified 24-Feb-2009

On Error GoTo ErrorHandler
   
   Set appWord = GetObject(, "Word.Application")
   strDefaultDocsPath = appWord.Options.DefaultFilePath(wdDocumentsPath) & "\"
   strDocsPath = GetProperty("InputDocsPath", strDefaultDocsPath)
   Debug.Print "Input Docs path: " & strDocsPath
   Set fso = CreateObject("Scripting.FileSystemObject")
   Set fld = fso.GetFolder(strDocsPath)
   Set dbs = CurrentDb
   Set rstTable = dbs.OpenRecordset("tblContacts", dbOpenDynaset)
   
   For Each fil In fld.Files
      strFile = fil.Name
      Debug.Print "File name: " & strFile
      Debug.Print "File type: " & fil.Type
      
      'Check whether file name starts with 'Contact ID'
      If Left(strFile, 10) = "Contact ID" Then
         'Extract Contact ID from file name, using Mid and
         'InStr to start at the beginning of the number and
         'end before the space following the number,
         'if there is one
         strTest = Mid(String:=strFile, Start:=12, Length:=3)
         intSpace = InStr(strTest, " ")
         
         If intSpace > 0 Then
            lngContactID = CLng(Mid(String:=strTest, _
               Start:=1, Length:=intSpace - 1))
         Else
            lngContactID = CLng(strTest)
         End If
         
         strSearch = "[ContactID] = " & lngContactID
         Debug.Print "Search string: " & strSearch
         strFileAndPath = strDocsPath & strFile
         
         'Search for matching Contact ID in table
         rstTable.MoveFirst
         rstTable.FindFirst strSearch
         If rstTable.NoMatch = True Then
            strTitle = "Can't find contact"
            strPrompt = "Contact ID " & lngContactID _
               & " not found in table; can't add attachment"
            GoTo NextDoc
         Else
            rstTable.Edit
            'Create recordset of attachments for this record
            Set rstAttachments = _
               rstTable.Fields("File").Value
               
         'Turn off error handler to prevent errors if the
         'code attempts to add the same file twice; in this
         'case the Attachments recordset won't be updated
On Error Resume Next
               
            With rstAttachments
               .AddNew
               .Fields("FileData").LoadFromFile _
                  (strFileAndPath)
               .Update
               .Close
            End With
            rstTable.Update
            Debug.Print "Added " & strFileAndPath _
               & " as attachment to Contact ID " _
               & lngContactID; "'s record"
         End If
      End If
      
NextDoc:
   Next fil
   
   'Open Contacts form to see the attachments
   'that have been loaded
   DoCmd.OpenForm FormName:="frmContacts"
   
ErrorHandlerExit:
   Exit Function

ErrorHandler:
   If Err = 429 Then
      'Word is not running; open Word with CreateObject
      Set appWord = CreateObject("Word.Application")
      Resume Next
   Else
      MsgBox "Error No: " & Err.Number & "; Description: " _
         & Err.Description
      Resume ErrorHandlerExit
   End If
   
End Function

Public Function SaveAttachments()
'Created by Helen Feddema 24-Feb-2009
'Last modified 24-Feb-2009

On Error GoTo ErrorHandler
   
   Set appWord = GetObject(, "Word.Application")
   strDefaultDocsPath = appWord.Options.DefaultFilePath(wdDocumentsPath) & "\"
   strDocsPath = GetProperty("OutputDocsPath", strDefaultDocsPath)
   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
   
ErrorHandlerExit:
   Exit Function

ErrorHandler:
   If Err = 429 Then
      'Word is not running; open Word with CreateObject
      Set appWord = CreateObject("Word.Application")
      Resume Next
   Else
      MsgBox "Error No: " & Err.Number & "; Description: " _
         & Err.Description
      Resume ErrorHandlerExit
   End If

End Function

Open in new window

These procedures are from my Access Archon #188, on working with the Attachment field:
http://www.helenfeddema.com/Files/accarch188.zip
0
 

Author Comment

by:peyton18
Comment Utility
Thank you for your comments.  I am now able to copy an Attachment field (and all of its documents) to an Attachment field in another table.  

My next question...Is there an easy way to copy only some of the documents contained in an Attachment field to an Attachment field in another table?  I want the user to be able to select one or all of the documents contained in an Attachment field and store only those documents in an Attachment field in another table.  Note that all of the Attachment documents already reside in the existing base table, they do not need to be imported or added prior to being moved to the target table and attachment field.
0
 
LVL 31

Expert Comment

by:Helen_Feddema
Comment Utility
Once you have saved the documents from the Attachment field to a folder, you could pop up a FilePicker dialog to let users select some of them to load into another table.  Here is a procedure for selecting a file:

Public Function SelectFile() As String
'Requires Office XP (2002) or higher
'Requires a reference to the Microsoft Office Object Library
'Created by Helen Feddema 28-Oct-2012
'Last modified by Helen Feddema 28-Oct-2012

On Error GoTo ErrorHandler

   Dim fd As Office.FileDialog
   Dim varSelectedItem As Variant
   Dim strFileNameAndPath As String
   
   'Create a FileDialog object as a File Picker dialog box.
   Set fd = Application.FileDialog(msoFileDialogFilePicker)
   
   With fd
      'Set AllowMultiSelect to True to allow selection of multiple files
      .AllowMultiSelect = False
      .Title = "Browse for File"
      .ButtonName = "Select"
      .Filters.Clear
      .Filters.Add "Documents", "*.doc; *.txt", 1
      .InitialView = msoFileDialogViewDetails
      If .Show = -1 Then
         'Get selected item in the FileDialogSelectedItems collection
         'Have to use collection even if just one item is selected
         For Each varSelectedItem In .SelectedItems
            strFileNameAndPath = CStr(varSelectedItem)
         Next varSelectedItem
      Else
         Debug.Print "User pressed Cancel"
         strFileNameAndPath = ""
      End If
   End With
   
   SelectFile = strFileNameAndPath
   
ErrorHandlerExit:
   Set fd = Nothing
   Exit Function

ErrorHandler:
   MsgBox "Error No: " & Err.Number _
      & " in SelectFile procedure; " _
      & "Description: " & Err.Description
   Resume ErrorHandlerExit

End Function

Open in new window


It would need some tweaking to work with multiple files.
0

Featured Post

Better Security Awareness With Threat Intelligence

See how one of the leading financial services organizations uses Recorded Future as part of a holistic threat intelligence program to promote security awareness and proactively and efficiently identify threats.

Join & Write a Comment

Overview: This article:       (a) explains one principle method to cross-reference invoice items in Quickbooks®       (b) explores the reasons one might need to cross-reference invoice items       (c) provides a sample process for creating a M…
I see at least one EE question a week that pertains to using temporary tables in MS Access.  But surprisingly, I was unable to find a single article devoted solely to this topic. I don’t intend to describe all of the uses of temporary tables in t…
In Microsoft Access, learn the trick to repeating sub-report headings at the top of each page. The problem with sub-reports and headings: Add a dummy group to the sub report using the expression =1: Set the “Repeat Section” property of the dummy…
In Microsoft Access, learn how to use Dlookup and other domain aggregate functions and one method of specifying a string value within a string. Specify the first argument, which is the expression to be returned: Specify the second argument, which …

744 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

10 Experts available now in Live!

Get 1:1 Help Now