Discussion :

[illight]

Bonjour,


Je développe actuellement une petite macro, qui va me permettre de :
- enregistrer les PJ d'un mail à un endroit spécifique
- supprimer les PJ du mail
- mettre dans le mail l'emplacement de ces PJ

Voici les macros que j'ai utilisé, en me basant sur les existantes trouvées ici et là :

Code :

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
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
 
Sub ExtractionPJ(strID As Outlook.MailItem)
Dim MyMail As Outlook.MailItem
Dim expediteur
Dim datejour As String
Set olNS = Application.GetNamespace("MAPI")
Set MyMail = olNS.GetItemFromID(strID.EntryID)
datejour = Year(Date) & Format(Month(Date), "00") & Format(Day(Date), "00")
'MsgBox "toto"
If MyMail.Attachments.Count > 0 Then
'    expediteur = MyMail.SenderEmailAddress
'on crée le répertoire où mettre les fichiers joints ##########################################################
'c:\temp\pj\ doit déjà exister !!!
    Repertoire = "D:\" & datejour & "\"
    If "" = Dir(Repertoire, vbDirectory) Then
        MkDir Repertoire
    End If
'on traite les pj
    Dim PJ, typeatt
    TextePJ = "PJ Enregistrées ici : " & vbCrLf
    For Each PJ In MyMail.Attachments
    'vérification si c'est une PJ Embedded
        typeatt = Isembedded(strID, PJ.Index)
        If typeatt = "" Then
            strFile = Repertoire & PJ.Filename
            PJ.SaveAsFile strFile
            TextePJ = TextePJ & strFile & vbCrLf
            'MyMail.Attachments.Remove 1
        End If
    Next PJ
    While MyMail.Attachments.Count > 0
        MyMail.Attachments(1).Delete
    Wend
    MyMail.Body = TextePJ & vbCrLf & MyMail.Body
    'drapeau vert
    'MyMail.FlagIcon = olYellowFlagIcon
    'Marque lu
    MyMail.UnRead = True
    MyMail.Save
End If
Set MyMail = Nothing
Set olNS = Nothing
End Sub
 
 
Function Isembedded(ByVal strEntryID As String, attindex As Integer) As Variant
    Dim oSession As Object
    ' CDO objects
    Dim oMsg As Object
    Dim oAttachs As Object
    Dim oAttach As Object
    ' initialize CDO session
    On Error Resume Next
    Set oSession = CreateObject("MAPI.Session")
    oSession.Logon "", "", False, False
    ' get the message created earlier
    Set oMsg = oSession.GetMessage(strEntryID)
    ' set properties of the attached graphic that make
    ' it embedded and give it an ID for use in an image tag
    Set oAttachs = oMsg.Attachments
    Set oAttach = oAttachs.Item(attindex)
    Dim strCID As String
    strCID = oAttach.Fields(&H3712001E)
    Isembedded = strCID
    Set oMsg = Nothing
    oSession.Logoff
    Set oSession = Nothing
End Function

L'enregistrement et la suppression des PJ fonctionne correctement de mon poste. Par contre, ce n'est pas une macro pour moi mais pour un collègue.

Je met cette macro en application à la réception d'un message, jusque là, rien d'anormal.

Par contre, quand mon collègue met en place cette macro, quand elle s'applique il a ce message sur le mail reçu original :



Et dans le mail "transformé" celui-ci :



Sur le 2e quand il clique sur la ligne, il peut remplacer le premier, et inversement. bref, comme s'il gardait les 2 mails. j'ai vu sur le net (mais j'ai pas trouvé de reponse, donc je me tourne vers vous) qu'il s'agissait d'un problème de conflit. J'ai vu qu'on pouvait les gérer par VB, mais je n'ai pas trouvé la solution.

Sauriez-vous comment faire ?
En fait, je voudrait uniquement garder le mail sans les PJ (j'en ai plus besoin...), donc transofmré par ma macro. Serait-ce un problème au niveau du Save ?



Autre question subsidiaire : il a reçu un mail avec un tableau à l'intérieur. Lors de l'application de la règle, le format du tableau a disparu, et tout était en ligne, tout moche et sans couleur. C'est dû au fait qu'il faut enregistrer le mail au format HTML ??
Si oui, je pense que je dois modifier ma macro de façon à faire en sorte qu'il soit en HTML en sortie à chaque fois, ça serait mieux non ?

En vous remerciant par avance pour vos réponses.

[Oliv-]

Bonjour
Est ce avec ol 2013 ?
Par contre le code de la fonction isembedded n est plus bon il faut le remplacer par celui la

Code :

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
Function PJ_Isembedded(ByVal PJ As Attachment) As Boolean
'---------------------------------------------------------------------------------------
' Procedure : PJ_Isembedded pour OL2010
' Author    : OLIV-
' Date      : 27/11/2014
' Purpose   : Indique si une PIECE JOINTE est INCORPOREE dans le Corps du Mail
'---------------------------------------------------------------------------------------
'
    Dim oPA As Outlook.PropertyAccessor
 
    Const PR_ATTACH_MIME_TAG = "http://schemas.microsoft.com/mapi/proptag/0x370E001E"
    Const PR_ATTACH_CONTENT_ID = "http://schemas.microsoft.com/mapi/proptag/0x3712001E"
    Const PR_ATTACHMENT_HIDDEN = "http://schemas.microsoft.com/mapi/proptag/0x7FFE000B"
 
    Set oPA = PJ.PropertyAccessor
'    MsgBox PJ & vbCr & "PR_ATTACHMENT_HIDDEN=" & oPA.GetProperty(PR_ATTACHMENT_HIDDEN) _
'         & vbCr & "PR_ATTACH_MIME_TAG=" & oPA.GetProperty(PR_ATTACH_MIME_TAG)
 
    If oPA.GetProperty(PR_ATTACH_CONTENT_ID) <> "" Then
        PJ_Isembedded = True
    Else
        PJ_Isembedded = False
    End If
 
End Function

[illight]

Bonjour,

Déjà merci pour le code

Et non, comme je l'ai indiqué dans le titre, c'est avec OL 2010
Ce qui est bizarre c'est que sur mon poste, je n'ai pas ce problème de conflit Chose du coup que je ne peux pas tester en réel

Merci déjà pour ta première réponse

[Oliv-]

Essaye déjà plutôt le code se trouvant ici , elle gère le HTML.

[illight]

Merci ça a marché !

Et le problème de conflit, on l'a finalement réglé : le problème se situait au niveau de l'exchange, car il avait les mails ET sur son ordi, et sur son téléphone, et du coup ça faisait conflit.

En fait, au niveau de la règle, il avait oublier de cocher la case "arrêter de traiter plus de règles". En cochant cette case, le problème s'est réglé.

Merci en tout cas pour ton aide, et ton attention

EDIT : avant de mettre le sujet en résolu, je voudrais tester le code sur son post. Je le mettrai dès que j'aurai sa validation

[illight]

Bonjour,


J'ai une dernière question : en utilisant ta fonction, on ne peut traiter, en quelque sorte, que les PJ du mail, et pas celles qui sont incoporés dans le mail ?

En effet, je viens de recevoir un mail, où la PJ est dans le mail, où j'avais mis cette condition :

Code :

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

1
2
3
4
        If PJ_Isembedded(pj) Then
            NomsPJ = NomsPJ & Separateur & "- " pj.Filename
            pj.Delete
        End If

Sauf qu'en faisant ça, quand je reçoit le mail, j'ai toujours la pièce jointe dans le mail.
j'ai donc enlevé la condition, pour que la PJ s'enregistre normalement, sauf que j'ai eu un message d'erreur à l'enregistrement :

Erreur d'exécution -2147467259 (800004005) :
Impossible d'exécuter cette action sur ce type de pièce jointe.

Du coup, comment on fait pour la sauvegarder et la supprimer du mail ?

[Oliv-]

Salut,
C'est tout l'interêt de PJ_Isembedded qui permet de savoir si c'est une pj incorporées dans le corps du mail on non.

A priori si c'est dans le corps c'est une image ? de quelle extension. OU alors est-ce un mail au format RTF ?

[illight]

Bonjour,


C'est du format RTF, car c'était un fichier Excel qui était présent dans le mail.

Par contre, c'est bizarre, je viens de faire 2 tests :
( un mail avec PJ classique
- un mail avec un format "enrichi" où tu peux mettre la PJ dans le mail

=> les 2 fois, ta requête m'a répondu faux

je comprend plus rien, hier ça marchait...

[Oliv-]

Bjr
En RTF les pj ne sont jamais "incorporées" donc l'export doit marcher pour toutes.