CODEWITHSUNDEEP
vbaoutlookattachment
OLLI_S
OLLI_S

Reputation: 117

Find out if an attachment is embedded or attached

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

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.

Upvotes: 5

Views: 3080

Answers (4)

Gener4tor
Gener4tor

Reputation: 388

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://learn.microsoft.com/en-us/openspecs/exchange_server_protocols/ms-oxprops/f6ab1613-aefe-447d-a49c-18217230b148#published-version (but I didn't)

Upvotes: 0

DinahMoeHumm
DinahMoeHumm

Reputation: 624

If you have the luxury of working in .NET rather than VBA, and after reading nicely reading outlook mailitem properties I realised that two of these properties can have different values depending on whether the message is in Unicode or not:

//PR_ATTACH_CONTENT_ID          0x3712001E (0x3712001F for Unicode) 
//PR_ATTACH_CONTENT_LOCATION    0x3713001E (0x3713001F for Unicode)

which means I should include these in my testing for values:

        Dim oPR As Outlook.PropertyAccessor = Nothing

        Try
            oPR = oAtt.PropertyAccessor
            If Not String.IsNullOrEmpty(oPR.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x3712001E")) _
            Or Not String.IsNullOrEmpty(oPR.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x3712001F")) _
            Or Not String.IsNullOrEmpty(oPR.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x3713001E")) _
            Or Not String.IsNullOrEmpty(oPR.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x3713001F")) Then
                If CInt(oPR.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x37140003")) = 4 Then
                    Return True
                End If
            End If
        Catch
        Finally
            If Not oPR Is Nothing Then
                Try
                    Marshal.ReleaseComObject(oPR)
                Catch

                End Try
            End If
            oPR = Nothing
        End Try

        Return False

I hope that, between this and @Gener4tor 's answer which may be better suited to VBA code (?) a reader can find a solution to their question around this.

Upvotes: 0

DinahMoeHumm
DinahMoeHumm

Reputation: 624

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

Upvotes: 1

Sam
Sam

Reputation: 5721

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.

Upvotes: 5

Related Questions