How I Exported an Attachment fields data to a folder

[nburleigh]

Haha, I know, don't you love the internet?

I actually noticed that it was working fine with most of the duplicate files, but was stopping near the end, and it seemed like it was stopping at the same file every time. I figured out a way to print what file it was stopping at, and it turned out that filename had an umlaut over an "i". My suspicion is that the exception had something to do with text encoding. I changed that one character in the filename, and voila. It worked!

Thanks for responding so many years later! And again--thanks for this post!

 

[InfernoJaffa]

Hi Chuck,

Gravedigging here as there is not a lot of coverage over running out of space due to the attachments fields...!

I'm following your guide religiously and now struggling at the form stage.

I've been able to get the form to open and show the filtered query data but have not been able to set up the "on before insert" action or the attach macro. I believe the macro commands have now been superseded as I am getting a lot of msoFileDialog errors from it.

Any help would be greatly appreciated, do you still have the db you could share?

Thanks!
Andy

 

[karenharris]

Hi,

I was very excited to see this code because we are migrating from an Access database to SQL and I need to extract all the attachments, but I am getting an error. I'm using Access 2016 and I get a run-time error '-2147024893 (80070003)'. When I click debug, it takes me to rsA("FileData").SaveToFile strFullPath

I have no idea why mine doesn't work when I see that other people have gotten this on the first try. Help please!:banghead:

 

[Mark_]

Can you please post your code?

Very difficult to let you know exactly what is going wrong if we can't see what you are doing.

 

[karenharris]

Option Compare Database
Public Function SaveAttachmentsTest(strPath As String, Optional strPattern As String = "*.*") As Long
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Dim rsA As DAO.Recordset2
Dim rsB As String
Dim fld As DAO.Field2
Dim OrdID As DAO.Field2
Dim strFullPath As String

'Get the database, recordset, and attachment field
Set dbs = CurrentDb
Set rst = dbs.OpenRecordset("SBDATA")
Set fld = rst("Attachments")
Set OrdID = rst("RCL")

'Navigate through the table
Do While Not rst.EOF

'Get the recordset for the Attachments field
Set rsA = fld.Value
rsB = OrdID.Value

'Save all attachments in the field
Do While Not rsA.EOF
If rsA("FileName") Like strPattern Then
'To Export the data, use the line below
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
SaveAttachmentsTest = SaveAttachmentsTest + 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

 

[Mark_]

Have you validated what is in StrPath prior to trying to save?

I would either put a msgbox in there or debug.print prior to the save.

If this is on the very first record

msgbox "Path to save to " & StrPath

may show you where it is going wrong.

 

[Gasman]

Have you also taken note of post 15, in that a reference is needed.?

 

[karenharris]

Hi,

Thanks for the help - I did include the reference, but I ended up finding someone elses code that worked perfectly for me.


Public Function AttachmentToDisk(strTableName As String, _
strAttachmentField As String, strPrimaryKeyFieldName As String)

Dim strFileName As String

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

Dim strPath As String

strPath = "D:\SB\Attachments"

Set db = CurrentDb

Set rsParent = db.OpenRecordset(strTableName, dbOpenSnapshot)

With rsParent
If .RecordCount > 0 Then .MoveFirst

While Not .EOF
' our picture is in the field "pics"
Set rsChild = rsParent(strAttachmentField).Value

If rsChild.RecordCount > 0 Then rsChild.MoveFirst

While Not rsChild.EOF

' this is the actual image content
Set fld = rsChild("FileData")

' create full path and filename
strFileName = strPath & .Fields(strPrimaryKeyFieldName) & "" & rsChild("FileName")

' create directory if it does not exists
If Len(Dir(strPath & .Fields(strPrimaryKeyFieldName), vbDirectory)) = 0 Then VBA.MkDir strPath & .Fields(strPrimaryKeyFieldName)
' remove any previous picture from disk it there is any
If Len(Dir(strFileName)) <> 0 Then Kill strFileName

' save our picture to disk
fld.SaveToFile strFileName

' move to next attachment
rsChild.MoveNext
Wend

' move record pointer of parent
.MoveNext
Wend

End With


Set fld = Nothing
Set rsChild = Nothing
Set rsParent = Nothing
Set db = Nothing

End Function

Private Sub Command0_Click()
Call AttachmentToDisk("SBDATA", "Attachments", "RCL")

End Sub

 

[chuckcoleman]

KarenHarris, I went to Bing with the error code and it talks about cannot find the path that you specified. I would check that.