'Error saving attachments when they are embedded

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.

Solution 1:^[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.)

Solution 2:^[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

Sources

This article follows the attribution requirements of Stack Overflow and is licensed under CC BY-SA 3.0.

Source: Stack Overflow

Solution	Source
Solution 1
Solution 2	Eugene Astafiev

'Error saving attachments when they are embedded

Solution 1:[1]

Solution 2:[2]

Sources

Related Questions

Solution 1:^[1]

Solution 2:^[2]