Discussion :

[Omega2015]

Bonjour,

Comment détruire un courriel entrant qui ne contient pas d'objet et émettre un message à l'expéditeur?

Merci.

[Oliv-]

Bonjour,
comme cela par exemple, avec outlook ouvert:
ici ca le supprime, il faut vider la corbeille pour le détruire;

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
Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
'---------------------------------------------------------------------------------------
' Procedure : Application_NewMailEx
' Author    : OCTU
' Date      : 03/04/2015
' Purpose   : Fait quelque chose à l'arrivée d'un message
'---------------------------------------------------------------------------------------
'
    Dim objFolderDestination As MAPIFolder
    Dim varEntryIDs
    Dim item
    Dim i As Integer
    Dim objMail As MailItem
    varEntryIDs = Split(EntryIDCollection, ",")
    For i = 0 To UBound(varEntryIDs)
        Set item = Application.Session.GetItemFromID(varEntryIDs(i))
        If Not item.Class = olMail Then GoTo fin
        Set objMail = item
        If objMail.subject = "" Then
            Call Action_Email(objMail)
            item.delete
        End If
    Next
fin:
End Sub
 
Sub Action_Email(objMail As MailItem)
'---------------------------------------------------------------------------------------
' Procedure : Action_Email
' Author    : octu
' Date      : 30/04/2015
' Purpose   :
'---------------------------------------------------------------------------------------
'
    Dim LaReponse As MailItem
    Set LaReponse = objMail.Reply    ' car ReplyAll ne met pas les PJ
    LaReponse.subject = "Pas de sujet à votre Email"
    MonTexteEnPlus = "Réponse au message ci-dessous envoyé le " & objMail.LastModificationTime
 
 
    Select Case LaReponse.BodyFormat
        'ici on vérifie le format du message HTML OU BRUT ...
 
    Case olFormatHTML:
 
        OuCommenceAdresse = InStr(1, LaReponse.HTMLBody, "<BODY", vbTextCompare)
        If OuCommenceAdresse > 0 Then
            fin = InStr(OuCommenceAdresse + 5, LaReponse.HTMLBody, ">") + 1
            BaliseBody = Mid(LaReponse.HTMLBody, OuCommenceAdresse, fin - OuCommenceAdresse)
 
            LaReponse.HTMLBody = Replace(LaReponse.HTMLBody, BaliseBody, BaliseBody & "<font style='font-family: Tahoma ;font-size: 12pt ;color:red;font-style: italic;'>" & MonTexteEnPlus & "</font><BR>" _
                                                                       & "<font style='font-family: Tahoma ;font-size: 12pt ;color:red;font-style: italic;'>" & String(NbTiret, "-") & "</font><BR><BR>", 1, 1, vbTextCompare)
        Else: LaReponse.HTMLBody = "<font style='font-family: Tahoma ;font-size: 12pt ;color:red;font-style: italic;'>" & liste & _
                                   "</font><BR>" & "<font style='font-family: Tahoma ;font-size: 12pt ;color:red;font-style: italic;'>" & String(NbTiret, "-") & "</font><BR><BR>" & LaReponse.HTMLBody
 
        End If
    Case Else
        LaReponse.Body = Replace(MonTexteEnPlus, "<br>", vbCr) & Chr(10) & String(NbTiret, "-") & Chr(10) & Chr(10) & LaReponse.Body
 
    End Select
    LaReponse.Display
    '    LaReponse.Send
End Sub

[Omega2015]

Bonjour Oliv,

Merci pour ta réponse!

Je suis vraiment néophyte!!

Pourrais-tu m'indiquer où placer ce code dans outlook pour que ça fonctionne, en fait la procédure pour l'implanter dans mon Outlook!

Merci encore et bonne journée.

[Oliv-]

Tu fais alt+f11 pour accèder aux macros
et tu mets cela dans Thisoutlooksession.

il faut changer aussi les contenus de tes sujets et Corps d'Email

Code :

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

1
2
 LaReponse.subject = "Pas de sujet à votre Email"
    MonTexteEnPlus = "Réponse au message ci-dessous envoyé le " & objMail.LastModificationTime

[Omega2015]

Tu fais alt+f11 pour accèder aux macros
et tu mets cela dans Thisoutlooksession.

il faut changer aussi les contenus de tes sujets et Corps d'Email

Code :

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

1
2
 LaReponse.subject = "Pas de sujet à votre Email"
    MonTexteEnPlus = "Réponse au message ci-dessous envoyé le " & objMail.LastModificationTime

Merci beaucoup.