Access Attachments

I am trying to code a  task: retrieving all attachments from Access (2013) database table and saving them to disk. Any thoughts on what the code would look like.
shieldscoAsked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Nick67Commented:
This is vice versa
http://www.experts-exchange.com/Database/MS_Access/Q_28315498.html
But there's a nice link in there
http://access-freak.com/tutorials.html#Tutorial07

That shows exactly what you'd want: Code to suck attachments back out.
You get a couple of Recordset2 objects on the go
The first one points to the table and field the attachments are in
The second -- because attachments are those abominable multi-valued tables -- points at the hidden stuff in the attachment field.

You the suck out the 'FileData' field and .SaveToFile it to a place in the filesystem

 On Error GoTo Err_SaveImage

 Dim db As DAO.Database
 Dim rsParent As DAO.Recordset2
 Dim rsChild As DAO.Recordset2

 Set db = CurrentDb
 Set rsParent = Me.Recordset

 rsParent.OpenRecordset

 Set rsChild = rsParent.Fields("AttachmentTest").Value

 rsChild.OpenRecordset
 rsChild.Fields("FileData").SaveToFile ("c:\")

 Exit_SaveImage:

Set rsChild = Nothing
 Set rsParent = Nothing
 Exit Sub

 Err_SaveImage:

 If Err = 3839 Then
 MsgBox ("File Already Exists in the Directory!")
 Resume Next

 Else
 MsgBox "Some Other Error occured!", Err.Number, Err.Description
 Resume Exit_SaveImage

 End If

Open in new window

shieldscoAuthor Commented:
I can runtime error 91 object variable or with  block variable not set in line  rsParent.OpenRecordset




 'On Error GoTo Err_SaveImage

 Dim db As DAO.Database
 Dim rsParent As DAO.Recordset2
 Dim rsChild As DAO.Recordset2

 Set db = CurrentDb
 Set rsParent = Me.Recordset

 rsParent.OpenRecordset

 Set rsChild = rsParent.Fields("Open ISA_MOU").Value

 rsChild.OpenRecordset
 rsChild.Fields("FileData").SaveToFile ("\\cdc.gov\private\L327\xbn8\Attachments\")

Exit_SaveImage:

Set rsChild = Nothing
 Set rsParent = Nothing
 Exit Sub

Err_SaveImage:

 If Err = 3839 Then
 MsgBox ("File Already Exists in the Directory!")
 Resume Next

 Else
' MsgBox "Some Other Error occured!", Err.Number, Err.Description
 Resume Exit_SaveImage

 End If
shieldscoAuthor Commented:
I get a runtime error 91 object variable or with  block variable not set in line  rsParent.OpenRecordset
IT Pros Agree: AI and Machine Learning Key

We’d all like to think our company’s data is well protected, but when you ask IT professionals they admit the data probably is not as safe as it could be.

shieldscoAuthor Commented:
May be I was not clear but I'm trying to export all access attachments to a folder. The access table name is tbl_MOU and the field name is Open ISA_MOU
Nick67Commented:
No, I do understand what you are attempting.
You'll need to walk down the rsParent until EOF, and within that walkdown you'll need to SET rsChild each time to each new attachment field

You'll need more here
Set rsParent = Me.Recordset
Forget it.  I don't think that won't do.  It's a Recordset2 object, not a Recordset object and that gets tricky.

Set rsParent = db.OpenRecordset("select * from tbl_MOU")

or something similar.

Then you need the walkdown

Do Until rsParent.EOF
    Set rsChild = rsParent.Fields("Open ISA_MOU").Value
    rsChild.OpenRecordset
    rsChild.Fields("FileData").SaveToFile ("\\cdc.gov\private\L327\xbn8\Attachments\")
    rsChild.Close
    Set rsChild = Nothing
    rsParent.MoveNext
Loop

More detail here
https://msdn.microsoft.com/en-us/library/bb258184%28v=office.12%29.aspx
Nick67Commented:
This one is exactly what you need

https://msdn.microsoft.com/en-us/library/office/ff191852.aspx

Public Function SaveAttachments(strPath As String, Optional strPattern As String = "*.*") As Long
    Dim dbs As DAO.Database
    Dim rst As DAO.Recordset2
    Dim rsA As DAO.Recordset2
    Dim fld As DAO.Field2
    Dim strFullPath As String
    
    'Get the database, recordset, and attachment field
    Set dbs = CurrentDb
    Set rst = dbs.OpenRecordset("tblAttachments")
    Set fld = rst("Attachments")
    
    'Navigate through the table
    Do While Not rst.EOF
    
        'Get the recordset for the Attachments field
        Set rsA = fld.Value
        
        'Save all attachments in the field
        Do While Not rsA.EOF
            If rsA("FileName") Like strPattern Then
                strFullPath = strPath & "\" & rsA("FileName")
                
                'Make sure the file does not exist and save
                If Dir(strFullPath) = "" Then
                    rsA("FileData").SaveToFile strFullPath
                End If
                
                'Increment the number of files saved
                SaveAttachments = SaveAttachments + 1
            End If
            
            'Next attachment
            rsA.MoveNext
        Loop
        rsA.Close
        
        'Next record
        rst.MoveNext
    Loop
    
    rst.Close
    dbs.Close
    
    Set fld = Nothing
    Set rsA = Nothing
    Set rst = Nothing
    Set dbs = Nothing
End Function

Open in new window

shieldscoAuthor Commented:
The code below works except when there is a blank attachment I get a runtime error 3021 no current record in line rsChild.Fields("FileData").SaveToFile ("\\cdc.gov\private\L327\xbn8\Attachments\")

 'On Error GoTo Err_SaveImage

 Dim db As DAO.Database
 Dim rsParent As DAO.Recordset2
 Dim rsChild As DAO.Recordset2

 Set db = CurrentDb
 'Set rsParent = Me.Recordset
 Set rsParent = db.OpenRecordset("select * from tbl_MOU")
 
 Do Until rsParent.EOF
     Set rsChild = rsParent.Fields("Open ISA_MOU").Value
     rsChild.OpenRecordset
     rsChild.Fields("FileData").SaveToFile ("\\cdc.gov\private\L327\xbn8\Attachments\")
     rsChild.Close
     Set rsChild = Nothing
     rsParent.MoveNext
 Loop
 

Exit_SaveImage:

Set rsChild = Nothing
 Set rsParent = Nothing
 Exit Sub

Err_SaveImage:

 If Err = 3839 Then
 MsgBox ("File Already Exists in the Directory!")
 Resume Next

 Else
' MsgBox "Some Other Error occured!", Err.Number, Err.Description
 Resume Exit_SaveImage

 End If
Nick67Commented:
I get a runtime error 3021 no current record
So then, check for an empty recordset!

 Do Until rsParent.EOF
      Set rsChild = rsParent.Fields("Open ISA_MOU").Value
      rsChild.OpenRecordset
      if rsChild.recordcount <> 0 then
          rsChild.Fields("FileData").SaveToFile ("\\cdc.gov\private\L327\xbn8\Attachments\")
      End if
      rsChild.Close
      Set rsChild = Nothing
      rsParent.MoveNext
  Loop
shieldscoAuthor Commented:
Compile error : Loop without DO
Nick67Commented:
'On Error GoTo Err_SaveImage

  Dim db As DAO.Database
  Dim rsParent As DAO.Recordset2
  Dim rsChild As DAO.Recordset2

  Set db = CurrentDb
  'Set rsParent = Me.Recordset
  Set rsParent = db.OpenRecordset("select * from tbl_MOU")
 
  Do Until rsParent.EOF
      Set rsChild = rsParent.Fields("Open ISA_MOU").Value
      rsChild.OpenRecordset
      If rsChild.recordcount <> 0 then
          rsChild.Fields("FileData").SaveToFile ("\\cdc.gov\private\L327\xbn8\Attachments\")
      End if
      rsChild.Close
      Set rsChild = Nothing
      rsParent.MoveNext
  Loop
 

 Exit_SaveImage:

 Set rsChild = Nothing
  Set rsParent = Nothing
  Exit Sub

 Err_SaveImage:

  If Err = 3839 Then
  MsgBox ("File Already Exists in the Directory!")
  Resume Next

  Else
 ' MsgBox "Some Other Error occured!", Err.Number, Err.Description
  Resume Exit_SaveImage

  End If
shieldscoAuthor Commented:
I get a runtime error 91 object variable or with  block variable not set in line   Do Until rsParent.EOF


This is the code:
Private Sub Command0_Click()
 'On Error GoTo Err_SaveImage

 Dim db As DAO.Database
 Dim rsParent As DAO.Recordset2
 Dim rsChild As DAO.Recordset2

 Set db = CurrentDb
 
  Do Until rsParent.EOF
       Set rsChild = rsParent.Fields("Open ISA_MOU").Value
       rsChild.OpenRecordset
       If rsChild.RecordCount <> 0 Then
           rsChild.Fields("FileData").SaveToFile ("\\cdc.gov\private\L327\xbn8\Attachments\")
       End If
       rsChild.Close
       Set rsChild = Nothing
       rsParent.MoveNext
   Loop

Exit_SaveImage:

Set rsChild = Nothing
 Set rsParent = Nothing
 Exit Sub

Err_SaveImage:

 If Err = 3839 Then
 MsgBox ("File Already Exists in the Directory!")
 Resume Next

 'Else
' MsgBox "Some Other Error occured!", Err.Number, Err.Description
 Resume Exit_SaveImage

 End If

End Sub
Nick67Commented:
Where did this go

 Set rsParent = db.OpenRecordset("select * from tbl_MOU")

That has to go before

  Do Until rsParent.EOF

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
shieldscoAuthor Commented:
Thanks
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Access

From novice to tech pro — start learning today.