Error saving attachments when they are embedded - vba

Question

I'm saving Outlook attachments (as part of a copy).
I get an error message from the line objAtt.SaveAsFile strFile when the attachment is an embedded image.
The code (gratefully copied!) is:
Sub CopyAttachments(objSourceItem, objTargetItem)
Dim objAtt As Outlook.Attachment
Set fso = CreateObject("Scripting.FileSystemObject")
Set fldTemp = fso.GetSpecialFolder(2) ' TemporaryFolder
strPath = fldTemp.Path & "\"
For Each objAtt In objSourceItem.Attachments
strFile = strPath & objAtt.FileName
objAtt.SaveAsFile strFile
objTargetItem.Attachments.Add strFile, , 1, objAtt.DisplayName
fso.DeleteFile strFile
Next
Set fldTemp = Nothing
Set fso = Nothing
End Sub
The full error message is:
I don't need embedded images, so skipping them would work too.

Answer 1

Is that an RTF message? RTF messages embed images and objects (such as Excel spreadsheets) not as files, but as OLE objects, and Attachment.SaveAsFile will fail for the OLE attachments. If you want to filter out attachments like that, make sure you either skip attachments with the Attachment.Type = olOLE (6) or only deal with the attachments of type olByValue or olEmbeddeditem.
If you still need to save OLE attachments, you can use Redemption (I am its author) - its RDOAttachment.SaveAsFile method will extract the file data from most common OLE attachments (such Word docs, PDF files, Excel spreadsheets, images, etc.)

Answer 2

First of all, make sure the file path is fully qualified, i.e. you end up with a valid string here:
strFile = strPath & objAtt.FileName
Second, when you call the Attachments.Add make sure the file exists on the disk. The source of the attachment can be a file (represented by the full file system path with a file name) or an Outlook item that constitutes the attachment.
You may try to run the following code which saves an attachment on the disk:
Sub SaveAttachment()
Dim myInspector As Outlook.Inspector
Dim myItem As Outlook.MailItem
Dim myAttachments As Outlook.Attachments
Set myInspector = Application.ActiveInspector
If Not TypeName(myInspector) = "Nothing" Then
If TypeName(myInspector.CurrentItem) = "MailItem" Then
Set myItem = myInspector.CurrentItem
Set myAttachments = myItem.Attachments
'Prompt the user for confirmation
Dim strPrompt As String
strPrompt = "Are you sure you want to save the first attachment " & _
"in the current item to the Documents folder? If a file with the " & _
"same name already exists in the destination folder, " & _
"it will be overwritten with this copy of the file."
If MsgBox(strPrompt, vbYesNo + vbQuestion) = vbYes Then
myAttachments.Item(1).SaveAsFile Environ("HOMEPATH") & "\My Documents\" & _
myAttachments.Item(1).DisplayName
End If
Else
MsgBox "The item is of the wrong type."
End If
End If
End Sub