Distinguish visible and invisible attachments with Outlook VBA

前端未结

关注

 3  1822

The requirement is to upload attachments to a server. However, we only want to upload those appears in the \"Message\" line (see pic below) of outlook, nothing else in the e

相关标签:

3条回答

谎友^

2020-12-03 18:56

As I can test so far, an embedded attachment always have a MIME content ID, regardless whether it appears in the mail body. So the solution is to check whether it has a content ID.

Here is an example code that counts the visible attachments:

Sub ShowVisibleAttachmentCount()
    Const PR_ATTACH_CONTENT_ID As String = "http://schemas.microsoft.com/mapi/proptag/0x3712001F"
    Const PR_ATTACHMENT_HIDDEN As String = "http://schemas.microsoft.com/mapi/proptag/0x7FFE000B"

    Dim m As MailItem
    Dim a As Attachment
    Dim pa As PropertyAccessor
    Dim c As Integer
    Dim cid as String

    Dim body As String

    c = 0

    Set m = Application.ActiveInspector.CurrentItem
    body = m.HTMLBody

    For Each a In m.Attachments
        Set pa = a.PropertyAccessor
        cid = pa.GetProperty(PR_ATTACH_CONTENT_ID)

        If Len(cid) > 0 Then
            If InStr(body, cid) Then
            Else
                'In case that PR_ATTACHMENT_HIDDEN does not exists, 
                'an error will occur. We simply ignore this error and
                'treat it as false.
                On Error Resume Next
                If Not pa.GetProperty(PR_ATTACHMENT_HIDDEN) Then
                    c = c + 1
                End If
                On Error GoTo 0
            End If
        Else
            c = c + 1
        End If
    Next a
    MsgBox c
End Sub

When I run through all my outlook emails it gives the same number of attachments in the line.

UPDATE

Thanks to Dmitry Streblechenko's information, I tested Outlook with email generated by Java Email library. The result shows that when an email attachment contains an CID but not appear in the email body, it will appear in the attachments line.

UPDATE

It looks there are still some cases that this is not good enough. I have generated the following MIME email body:

Message-ID: <1044564324.2.1360638429705.JavaMail.joe@xxxx>
Subject: Test
MIME-Version: 1.0
Content-Type: multipart/alternative; 
    boundary="----=_Part_0_1327112367.1360638429515"
Return-Path: xxxx@xxxx.xxx
X-OriginalArrivalTime: 12 Feb 2013 03:07:16.0096 (UTC) FILETIME=[0FC1B000:01CE08CE]

------=_Part_0_1327112367.1360638429515
Content-Type: text/plain; charset=us-ascii
Content-Transfer-Encoding: 7bit

TTT
------=_Part_0_1327112367.1360638429515
Content-Type: multipart/related; 
    boundary="----=_Part_1_1747887937.1360638429520"

------=_Part_1_1747887937.1360638429520
Content-Type: text/html; charset=UTF-8
Content-Transfer-Encoding: quoted-printable

<html><head><meta http-equiv=3D'content-type' content=3D'text/html; charset=
=3DUTF-8'></head><title>TTT</title><body><img src=3D"cid:test1.png" alt=3D'=
=E6=81=AD=E8=B4=BA=E6=96=B0=E7=A6=A7' /><p>txt</p></body></html>
------=_Part_1_1747887937.1360638429520
Content-Type: image/png
Content-Transfer-Encoding: base64
Content-ID: <test.png>

iVBORw0KGgoAAAANSUhEUgAAAIIAAAAmCAYAAAAIjkMFAAABHUlEQVR42u3Z0Q7CIAyFYd//pafx
ckFoS9ELvz8aE9mQrIfTFh8PAAAAAPgp1+t1vT9i32fm6FzP6JrKb3aulRAGARm9Z9dUAhWZY7Wm
7Hr+IvhdD+s+PhLCLNBZQZ12HI7QlBqyQohctxM8bvAFIcx2eEYIo/vuY5WAi3BzWlhZ+if7zs7T
UWtE10Asgd3bUSxWHvrMobJOtXITQkjk5Z3gdaWaqBBWouYIhdy+E+TsPNHU0CUEbjDJ49GxE0KI
nBNUheAcYbPVy9QNmRaxUvVHd7Idf0gU2QDOduVqnkinoEb4QY1Q3V2RNrMqpB0h6BqKh0gZIWT/
AzjVycwcjSMcPI3buSebZiptaLbIBQAAAAAAAAAAAAAAAP6OJyO5jJ4bZa/gAAAAAElFTkSuQmCC

------=_Part_1_1747887937.1360638429520--

------=_Part_0_1327112367.1360638429515--

Notice that I have changed the referencing image content id in the body, and the actual image have a wrong content ID (so it is not referenced). However the image is not in the main part of the email (it is in a branch of an alternative part). That makes it invisible in outlook.

So to detect we have to make sure the attachment appears in the main MIME part... Looking for ways to do so.

UPDATE

Further digging I reaches this link and I added one more test - the PR_ATTACHMENT_HIDDEN property.

Also it is worth to say that outlook 2010 itself is not consistent. I have observed that sometimes the email list shows the attachment icon to indicate existence of attachments but there are nothing appear when opening it in an inspector.

References:

Sending Outlook Email with embedded image using VBS

MSDN - Attachment Properties

Forum - Identifying inline attachments

0 讨论(0)

情书的邮戳

2020-12-03 18:59

Some attachments always have the MIME content id (PR_ATTACH_CONTENT_IDenter code here), in particular messages from Lotus Notes always have that header.
The real test is to check the HTMLBody property and see if any attachments are actually referenced by the img tags. Redemption lets you distinguish attachment like that using the RDOAttachment.Hidden property.

0 讨论(0)
发布评论:

提交评论
- 加载中...

粉色の甜心

2020-12-03 19:03

Based on answer by @Earth Engine , here it is a function returning the real number of attachments upon passing a mailitem (item.class = olMail) as parameter:

Function CountVisibleAttachment(ByVal m As MailItem) As Integer
    Const PR_ATTACH_CONTENT_ID As String = "http://schemas.microsoft.com/mapi/proptag/0x3712001F"
    Const PR_ATTACHMENT_HIDDEN As String = "http://schemas.microsoft.com/mapi/proptag/0x7FFE000B"

    Dim a As Attachment
    Dim pa As propertyAccessor
    Dim c As Integer
    Dim cid As String

    Dim body As String

    c = 0

    body = m.HTMLBody

    For Each a In m.Attachments
        Set pa = a.propertyAccessor
        cid = pa.GetProperty(PR_ATTACH_CONTENT_ID)

        If Len(cid) > 0 Then
            If InStr(body, cid) Then
            emb = emb + 1
            Else
                'In case that PR_ATTACHMENT_HIDDEN does not exists,
                'an error will occur. We simply ignore this error and
                'treat it as false.
                On Error Resume Next
                If Not pa.GetProperty(PR_ATTACHMENT_HIDDEN) Then
                    c = c + 1
                End If
                On Error GoTo 0
            End If
        Else
            c = c + 1
        End If
    Next a
    CountVisibleAttachment = c
End Function

0 讨论(0)