Oliv-

Bonjour,

J'avais déjà donné dans le forum OUTLOOK VBA, une nouvelle version pour OL 2007 et suivants à la fonction qui se trouve dans la FAQ et qui permet de Vérifier si une Pièce jointe est incorporée dans le corps du Mail ou une vrai PJ.

Mais voilà dans certains cas le résultat était faux, alors voici une nouvelle version.

Code vba :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
Function PJ_Isembedded(ByVal pj As Attachment) As Boolean
'---------------------------------------------------------------------------------------
' Procedure : PJ_Isembedded pour OL2010
' Author    : OLIV-
' Date      : 05/06/2015
' Version   : 2
' Purpose   : Indique VRAI si une PIECE JOINTE est INCORPOREE dans le Corps du Mail
'---------------------------------------------------------------------------------------
'
    Dim oPA As Outlook.PropertyAccessor
 
    Dim ATTACH_MIME_TAG
    Dim ATTACH_CONTENT_ID
    Dim ATTACHMENT_HIDDEN
    Dim ATTACH_FLAGS
    Dim ATTACH_CONTENT_LOCATION
    Dim ATTACH_METHOD
 
 
    Const PR_ATTACH_MIME_TAG = "http://schemas.microsoft.com/mapi/proptag/0x370E001E"
    Const PR_ATTACHMENT_HIDDEN = "http://schemas.microsoft.com/mapi/proptag/0x7FFE000B"
    Const PR_ATTACH_CONTENT_ID = "http://schemas.microsoft.com/mapi/proptag/0x3712001E"
    Const PR_ATTACH_FLAGS = "http://schemas.microsoft.com/mapi/proptag/0x37140003"
    Const PR_ATTACH_CONTENT_LOCATION = "http://schemas.microsoft.com/mapi/proptag/0x3713001E"
    Const PR_ATTACH_METHOD = "http://schemas.microsoft.com/mapi/proptag/0x37050003"
 
    Set oPA = pj.PropertyAccessor
 
    On Error Resume Next
    ATTACH_MIME_TAG = oPA.GetProperty(PR_ATTACH_MIME_TAG)
    ATTACHMENT_HIDDEN = oPA.GetProperty(PR_ATTACHMENT_HIDDEN)
    ATTACH_CONTENT_ID = oPA.GetProperty(PR_ATTACH_CONTENT_ID)
    ATTACH_FLAGS = oPA.GetProperty(PR_ATTACH_FLAGS)
    ATTACH_CONTENT_LOCATION = oPA.GetProperty(PR_ATTACH_CONTENT_LOCATION)
    ATTACH_METHOD = oPA.GetProperty(PR_ATTACH_METHOD)
 
    'MsgBox pj & vbCr & "PR_ATTACH_MIME_TAG=" & ATTACH_MIME_TAG _
         & vbCr & "PR_ATTACHMENT_HIDDEN=" & ATTACHMENT_HIDDEN _
         & vbCr _
         & vbCr & "PR_ ATTACH_CONTENT_ID=" & ATTACH_CONTENT_ID _
         & vbCr & "PR_ATTACH_FLAGS=" & ATTACH_FLAGS _
         & vbCr & "PR_ATTACH_CONTENT_LOCATION=" & ATTACH_CONTENT_LOCATION _
         & vbCr & "PR_ATTACH_METHOD=" & ATTACH_METHOD
 
    If (ATTACH_CONTENT_ID <> "" And ATTACH_FLAGS = 4) Or ATTACH_METHOD = 6 Then
        PJ_Isembedded = True
    Else
        PJ_Isembedded = False
    End If
 
End Function

et voici un code pour tester à partir du Mail courant (ouvert)

Code vba :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
Private Sub TESPJ_Isembedded()
    Dim Mymail As Outlook.MailItem
    Set Mymail = ActiveInspector.CurrentItem
    Dim pj, TypeAtt
    For Each pj In Mymail.Attachments
        'vérification si c'est une  PJ  Embedded
        TypeAtt = PJ_Isembedded(pj)
        MsgBox pj.FileName & vbCr & TypeAtt, vbOKOnly, "Est une image Incorporée ?"
    Next
End Sub