Oliv-

RECEVOIR DES EVENEMENTS SUR PLUSIEURS EMAILS OUTLOOK

Noter ce billet

par

Oliv-

, 07/03/2016 à 19h03 (1182 Affichages)

Si vous voulez recevoir des Evénements sur plusieurs EMAILS ouverts, vous devez utiliser un Module de classe.

Ici nous allons tester le CHANGEMENT de SUJET d'un Email et agir selon.

A METTRE dans THISOUTLOOKSESSION

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
 
 
 
Private m_MyEmails As VBA.Collection
Private m_lNextKeyEmails As Long
 
 
Private Sub Application_ItemLoad(ByVal item As Object)
'---------------------------------------------------------------------------------------
' Procedure : Application_ItemLoad
' Author    : Oliv
' Date      : 07/03/2016
' Purpose   : EMAIL WRAPPER / Receive Events of Multiple Emails
' BASED ON : http://www.vboffice.net/en/developers/inspector-wrapper-receive-events-of-multiple-emails/
'---------------------------------------------------------------------------------------
'
 
    Dim oMail As cMail
    If m_MyEmails Is Nothing Then Set m_MyEmails = New VBA.Collection
    Set oMail = New cMail
    If item.Class = olMail Then
        If oMail.Init(item, CStr(m_lNextKeyEmails)) Then
            m_MyEmails.Add oMail, CStr(m_lNextKeyEmails)
            m_lNextKeyEmails = m_lNextKeyEmails + 1
        End If
    End If
 
End Sub
 
Friend Property Get MyEmails() As VBA.Collection
    Set MyEmails = m_MyEmails
End Property

AJOUTER UN MODULE DE CLASSE et le nommer "cMail"

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
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
 
'---------------------------------------------------------------------------------------
' Module    : cMail
' Author    : Oliv
' Date      : 07/03/2016 17:49
' Purpose   : EMAIL WRAPPER / Receive Events of Multiple Emails
'---------------------------------------------------------------------------------------
 
 
Private WithEvents m_Mail As Outlook.MailItem
Private m_IsClosed As Boolean
Private m_sKey As String
 
Friend Function Init(oEmail As Outlook.MailItem, sKey As String) As Boolean
    Dim obj As Object
 
    If Not oEmail Is Nothing Then
 
        Set m_Mail = oEmail
        m_sKey = sKey
        Init = True
    End If
 
End Function
 
 
 
Private Sub Class_Terminate()
    CloseEmail
End Sub
 
Friend Sub CloseEmail()
    On Error Resume Next
    If m_IsClosed = False Then
        m_IsClosed = True
        ThisOutlookSession.MyEmails.Remove m_sKey
        Set m_Mail = Nothing
    End If
End Sub
 
 
 
Private Sub m_Mail_Close(Cancel As Boolean)
    CloseEmail
End Sub
 
Private Sub m_Mail_PropertyChange(ByVal Name As String)
'---------------------------------------------------------------------------------------
' Procedure : m_Mail_PropertyChange
' Author    : Oliv
' Date      : 07/03/2016
' Purpose   : Événement sur les changements de propriétés
'---------------------------------------------------------------------------------------
'
    Dim pj
    Dim MyRecipientCC As Recipient, CC
    pj = "C:\Users\Comptabilité\Documents\joindredoc.pdf"
    'pj = "C:\temp\monpdf.pdf"
    CC = "INFO@AAA.COM"
 
    If Name = "Subject" Then
'ICI on test le sujet et on fait les ACTIONS
        If InStr(1, m_Mail.Subject, "SOUMISSION", vbTextCompare) Then    'non sensible à la casse
            'if instr(0, m_Mail.Subject,"SOUMISSION",vbBinaryCompare) then 'sensible à la casse
            If Dir(pj) <> "" Then
                m_Mail.Attachments.Add pj
            End If
 
            Set MyRecipientCC = m_Mail.Recipients.Add(CC)
            MyRecipientCC.Type = olCC
            MyRecipientCC.Resolve
        End If
    End If
End Sub

Vous constaterez qu'à chaque fois que le SUJET d'un Email en cours sera changé et contiendra "SOUMISSION" , il y aura ajout d'une pj et du destinataire en CC.
On peut bien sûr contrôler au préalable l’existence de la PJ dans les "attachments" et le destinataire CC dans les "recipients"

Pour tester les autres événements

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
 
Private Sub m_Mail_AfterWrite()
MsgBox "m_Mail_AfterWrite fire" '& vbCr & m_Mail.Subject
End Sub
 
Private Sub m_Mail_AttachmentRemove(ByVal Attachment As Attachment)
Msgbox  this.Name  
End Sub
 
Private Sub m_Mail_BeforeRead()
MsgBox "m_Mail_BeforeRead fire"
End Sub
 
Private Sub m_Mail_Close(Cancel As Boolean)
MsgBox "m_Mail_Close Fire" & vbCr & m_Mail.Subject
    CloseEmail
End Sub
 
Private Sub m_Mail_Open(Cancel As Boolean)
MsgBox "m_Mail_Open fire" & vbCr & m_Mail.Subject
End Sub
 
 
Private Sub m_Mail_Forward(ByVal Forward As Object, Cancel As Boolean)
MsgBox "fire m_Mail_Forward" & vbCr & Forward.BodyFormat
End Sub
 
Private Sub m_Mail_Read()
MsgBox "m_Mail_Read fire" & vbCr & m_Mail.Subject
End Sub
 
Private Sub m_Mail_Reply(ByVal Response As Object, Cancel As Boolean)
 MsgBox "REPLY"
End Sub
 
Private Sub m_Mail_ReplyAll(ByVal Response As Object, Cancel As Boolean)
 MsgBox "REPLYALL"
End Sub
 
Private Sub m_Mail_Unload()
MsgBox "m_Mail_Unload" '& vbCr & m_Mail.Subject
End Sub