Find out if an attachment is embedded or attached

Question

I am coding a small VBA to show all attachments of an email in a list box.

The user can select attachments that should be removed from the email and stored on a target folder.

I am also adding a HTML file to the email that contains a list of all removed files (including a link to each file to the target folder).

I have a problem with images, because they can be

• Attached as a normal file to the email
• Embedded to the email body (like a company logo in the signature)

I want to show in my list box only those images, that are attached as files to the email.

Embedded mails should be ignored.

Sub SaveAttachment()

    Dim myAttachments           As Outlook.Attachments
    Dim olMailItem              As Outlook.MailItem
    Dim lngAttachmentCount      As Long
    Dim Attachment_Filename     As String

    Select Case True

        Case TypeOf Application.ActiveWindow Is Outlook.Inspector
            Set olMailItem = Application.ActiveInspector.CurrentItem
        Case Else

        With Application.ActiveExplorer.Selection
            If .Count Then Set olMailItem = .Item(1)
        End With

        If olMailItem Is Nothing Then Exit Sub

    End Select

    Set myAttachments = olMailItem.Attachments

    If myAttachments.Count > 0 Then

        For lngAttachmentCount = myAttachments.Count To 1 Step -1

            '-------------------------------------------------------------------------
            ' Add the attachment to the list of attachments (form)
            '-------------------------------------------------------------------------
            Attachment_Filename = myAttachments(lngAttachmentCount).FileName

            With UserForm1.lstAttachments

                .AddItem (Attachment_Filename)
                .List(lngAttachmentListPos, 1) = Attachment_Type_Text
                .List(lngAttachmentListPos, 2) = FormatSize(myAttachments(lngAttachmentCount).Size) & " KB"

            End With

        Next lngAttachmentCount

    End If

End Sub

I added only the relevant parts of the code, so I hope I have not forgotten anything.

At the moment I show all attachments (also embedded images).

How would I find out if an attachment is embedded?

I found a possible solution here: Distinguish visible and invisible attachments with Outlook VBA
The source code provided is not working, it seems like the two URLs in line 2 and 3 no longer exist.

Answer 1

I'm not sure if this is a solution that is valid in all cases, but it works in my environment. That means "test it properly".

Const PR_ATTACH_CONTENT_ID = "http://schemas.microsoft.com/mapi/proptag/0x3712001F"

Function IsEmbedded(Att As Attachment) As Boolean
    Dim PropAccessor As PropertyAccessor
    Set PropAccessor = Att.PropertyAccessor
    IsEmbedded = (PropAccessor.GetProperty(PR_ATTACH_CONTENT_ID) <> "")
End Function

Call it with

If IsEmbedded(myAttachments(lngAttachmentCount)) Then
    ...
End If

The cryptic url-looking constant is not a url, but a property identifier. You can find a list of them here: https://interoperability.blob.core.windows.net/files/MS-OXPROPS/%5bMS-OXPROPS%5d.pdf

That property is set to the url of the attachment if embedded. If not embedded, then it is empty.

Answer 2

In the Outlook object model it's very important to marshal your objects correctly. Leaving a PropertyAccessor hanging about is not good, so I would suggest a minor modification to the accepted answer as follows:

Const PR_ATTACH_CONTENT_ID = "http://schemas.microsoft.com/mapi/proptag/0x3712001F"

Function IsEmbedded(Att As Attachment) As Boolean
    Dim PropAccessor As PropertyAccessor = Nothing
    Try
        PropAccessor = Att.PropertyAccessor
        Return (PropAccessor.GetProperty(PR_ATTACH_CONTENT_ID) <> "")
    Catch
        Return False
    Finally
        If PropAccessor IsNot Nothing
            Marshal.ReleaseCOMObject(PropAccessor)
        End If
    End Catch
End Function

Answer 3

With the help of the answer and comment from @DinahMoeHumm we went with this solution which seems to work:

Function outlook_att_IsEmbedded(Att As outlook.Attachment) As Boolean
    
  Dim PropAccessor As outlook.PropertyAccessor
    
  On Error GoTo outlook_att_IsEmbedded_error
    
  outlook_att_IsEmbedded = False
    
  Set PropAccessor = Att.PropertyAccessor
        
  If PropAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x3712001E") <> "" Or _
     PropAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x3713001E") <> "" Then
           
    If PropAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x37140003") = 4 Then
       outlook_att_IsEmbedded = True
    End If
  End If

outlook_att_IsEmbedded_exit:
  Set PropAccessor = Nothing

  Exit Function

outlook_att_IsEmbedded_error:
  outlook_att_IsEmbedded = False
  Resume outlook_att_IsEmbedded_exit
                
End Function

I don't know what the different probtags mean. Or what the 4 is. It seems like you could find a list of them here: https://interoperability.blob.core.windows.net/files/MS-OXPROPS/%5bMS-OXPROPS%5d.pdf (but I didn't)