Discussion :

[d.tellier]

Bonjour,
Je suis sous Outlook 2016 et Exchange.

Après plusieurs recherches de code (à modifier) à la réception d'un nouveau message je suis tombé sur ces 2 codes ci-dessous que j'aimerais modifié à ma convenance.

Voici ce que je veux réaliser sur les mails reçus : 2 actions sur les mails reçu :
- Mettre une catégorie (couleur) : mail à lire
- Renseigner un champ société en fonction du domaine du mail de l’expéditeur. (mais avec des exceptions aussi)

exemple : j.calfert@carac.fr ==> société = carac

si j.calfert@orange.fr ==> soit :

- dans le programme je fait des exception en disant : j.calfert@orange.fr donne société = carac (Ca je sais faire)
- la société est lu dans le champ société si le contact est enregistré dans ma base contact local d'Outlook (Ca je ne sais pas faire)
- j'utilise une table SQL ou un fichier type "texte, Excel, Access, etc..." (Ca je ne sais pas faire)

Pour commencer j'ai tester deux procédure de Morgan BILLY à l'adresse : http://dolphy35.developpez.com/article/outlook/vba/ (et la je bloque)

http://dolphy35.developpez.com/artic...ok/vba/#LV-A-9

Code :

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

1
2
3
Private Sub Application_NewMail1()
    MsgBox "Vous venez de recevoir un nouveau Mail !", vbExclamation
End Sub

et

http://dolphy35.developpez.com/artic...k/vba/#LV-A-10

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
Private Sub Application_NewMailEx2(ByVal EntryIDCollection As String)
'---------------------------------------------------------------------------------------
' Procédure : Application_NewMailEx
' Auteur    : Dolphy35
' Site      : http://dolphy35.developpez.com
' Détail    : Permet de déplacer le nouveau message si celui-ci est envoyé par un expéditeur précis
'---------------------------------------------------------------------------------------
'
    'Déclarations
    Dim MonApp As Outlook.Application
    Dim MonMail As Object
    Dim MonNameSpace As Outlook.NameSpace
    Dim MonDossier As Outlook.Folder
 
    'Instance des objets
    Set MonApp = Outlook.Application
    Set MonNameSpace = MonApp.GetNamespace("MAPI")
    Set MonDossier = MonNameSpace.GetDefaultFolder(olFolderInbox)
    Set MonMail = Application.Session.GetItemFromID(EntryIDCollection)
 
        'Test si l'expéditeur correspond dans ce cas on déplace le mail
        'vers le dossier Temp de votre boîte de réception
        If MonMail.SenderEmailAddress = "toto@orange.fr" Then
            'MonMail.Move MonDossier.Folders("Temp")
            MsgBox "Vous venez de recevoir un nouveau Mail !", vbExclamation
        End If
End Sub

C'est 2 procédure ne font rien. Je l'ai copié dans ThisOulookSession et ensuite j'ai créé un module ou je les ai déplacé. Et toujours rien.
Je ne comprend pas toujours bien la logique VBAOutlook.

Qui peux m'aider. merci.

Cordialement D. TELLIER

[Oliv-]

SAlut,

Ces procédures utilisent des "événements" leur nom est imposé

tu ne peux avoir Application_NewMailex2 tu dois avoir Application_NewMailEx

qui plus est avec les bon arguments

Sub Application_NewMailEx(ByVal EntryIDCollection As String)

Ennd sub

[Oliv-]

Pour ton champ société ton code devrait ressembler à cela

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
    Dim oExp As Outlook.AddressEntry
    Dim oExpContact As Outlook.ContactItem
    Dim oExUser As Outlook.ExchangeUser
    Dim Ste As String, temp
 
    Ste = ""
    Set oExp = oItem.Sender
    Set oExpContact = oExp.GetContact
    If Not oExpContact Is Nothing Then
        Ste = oExpContact.CompanyName
    Else
        Set oExUser = oExp.GetExchangeUser
        If Not oExUser Is Nothing Then
        Ste = oExUser.CompanyName
        End If
    End If
    If Ste = "" Then
    temp = Split(oItem.Sender.Address, "@")(1)
        Ste = StrReverse(Split(StrReverse(temp), ".", -1)(1))
 
    End If
    MsgBox Ste

[d.tellier]

Bonjour,
Désolé j'avais bien mis

Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)

et rien ne se passe je n'ai pas de fenêtre

Code :

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

1
2
3

MsgBox "Vous venez de recevoir un nouveau Mail !", vbExclamation

qui s'affiche quand je reçois un message.

A+

[Oliv-]

BONJOUR,

Il faut vérifier les paramètres de sécurité des macros.