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.
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.