Still celebrating National IT Professionals Day with 3 months of free Premium Membership. Use Code ITDAY17

x
?
Solved

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

Posted on 2014-09-25
4
Medium Priority
?
950 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 2
4 Comments
 
LVL 74

Expert Comment

by:Jeffrey Coachman
ID: 40344753
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 2000 total points
ID: 40346180
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
ID: 40346841
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
ID: 40346956
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

10 Questions to Ask when Buying Backup Software

Choosing the right backup solution for your organization can be a daunting task. To make the selection process easier, ask solution providers these 10 key questions.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

It’s the first day of March, the weather is starting to warm up and the excitement of the upcoming St. Patrick’s Day holiday can be felt throughout the world.
The Windows Phone Theme Colours is a tight, powerful, and well balanced palette. This tiny Access application makes it a snap to select and pick a value. And it doubles as an intro to implementing WithEvents, one of Access' hidden gems.
In Microsoft Access, when working with VBA, learn some techniques for writing readable and easily maintained code.
With Secure Portal Encryption, the recipient is sent a link to their email address directing them to the email laundry delivery page. From there, the recipient will be required to enter a user name and password to enter the page. Once the recipient …

722 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