Saving Attachments (1 Viewer)

[rangersedge]

Ok. So I have learned my lesson on saving images into an Access DB. Now I'm using VBA (another good learning experince) to save the images back to a folder. I have a code working that will save the images but I need it to also rename the images after saving.

The section "MyFile = OldFile" needs to reference the rsChild Attachment file name...

Private Sub Command859_Click()
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("Attachments").Value

With rsChild
.MoveFirst
Do While Not .EOF

rsChild.OpenRecordset
rsChild.Fields("FileData").SaveToFile ("V:\Lego\MediaDB\Images")

Exit_SaveImage:

.MoveNext

Loop
.Close
End With

MyPath = "V:\Lego\MediaDB\Images\"
MyFile = OldFile
NewName = Me.Title
Name MyPath & MyFile As MyPath & NewName

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

 

[Old Man Devin]

I don't know for sure, but I believe the attachment has a FileName property you can use. Have never done this, but perhaps something like:

MyFile = rsChild.Fields("FileName").Value

will achieve the goal.

 

[rangersedge]

I had tried that before but kept getting errors saying the object did not exist. The problem was the placement of the renaming section. I moved that section to before the "Exit_SaveImage:" and now it works perfectly. I will post the entire code in case anyone wants to use it.

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("Attachments").Value

With rsChild
.MoveFirst
Do While Not .EOF

rsChild.OpenRecordset
rsChild.Fields("FileData").SaveToFile ("V:\Lego\MediaDB\Images")

MyPath = "V:\Lego\MediaDB\Images\"
MyFile = rsChild.Fields("FileName").Value
NewName = Me.Title
Name MyPath & MyFile As MyPath & NewName

Exit_SaveImage:

.MoveNext

Loop
.Close
End With



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