Macro Outlook 2003 exécution auto des règles de messagerie [Résolu]

[meumeu73.1]

Bonjour à tous,

j'aimerais pouvoir exécuter toutes mes règles de messagerie dès l'arrivée d'un message, est il possible de le faire via une macro qui s'auto-exécute dès réception.

La raison de ma demande est qu'actuellement sur notre système on peut créer autant de règles que l'on veut, mais elle ne peuvent pas être toutes activées.

par avance merci.

[Oliv-]

Bonjour,
Vous pouvez utiliser l'option exécuter un script et donc développer vos regles dans la macro.

Code :

1
2
3
Sub script (MyMail As MailItem) 
    MsgBox MyMail.Subject & " est arrivé " 
End Sub

[meumeu73.1]

Bonjour,

Est il possible d'avoir un peu plus de précision :

- ou je sélectionne l'option exécuter un script,
- et avoir un exemple de marcro, par rapport un message reçu d'une personne en particulier vers un dossier portant son nom.

par avance merci

j'ai trouvé pour l'execution d'un script

[Oliv-]

SAlut,

Voici un exemple le dossier destinataire se trouve dans la boite de reception.

Je teste ici l'adresse Email de l'expéditeur (à partir de OUTLOOK 2003 uniquement je pense) mais on peux tester d'autres propriétés.

Code :

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
Sub Script_deplace(MyMail As Outlook.MailItem)
'---------------------------------------------------------------------------------------
' Procedure : Script_deplace
' Author    : Oliv'
' Date      : 14/03/2008
' Purpose   : Script pour règle --> déplace un mail vers un dossier
'---------------------------------------------------------------------------------------
'
   Dim OLNS As Outlook.NameSpace
   Set OLNS = Application.GetNamespace("MAPI")
   DestinationName = ""
 
    Select Case MyMail.SenderEmailAddress
        Case "toto@titi.fr"
            'déplacement direct avec erreur si le dossier n'existe pas
            MyMail.Move OLNS.GetDefaultFolder(olFolderInbox).Folders("toto")
 
        Case "momo@titi.fr"
            ' à partir d'ici traitement à la fin uniquement
            DestinationName = "momo"
        Case "forum@redaction-developpez.com"
            DestinationName = MyMail.SenderName
    End Select
    If DestinationName <> "" Then
        On Error Resume Next
            Set MyDestinationFolder = OLNS.GetDefaultFolder(olFolderInbox).Folders(DestinationName)
            If Err <> 0 Then
                ' création du dossier s'il nexiste pas
                 Set MyDestinationFolder = OLNS.GetDefaultFolder(olFolderInbox).Folders.add(DestinationName, olFolderInbox)
                 Err.Clear
            End If
        On Error GoTo 0
    'Déplacement
    MyMail.Move MyDestinationFolder
    End If
 
End Sub

[meumeu73.1]

Bonjour,

Encore merci, ça fonctionne bien à part que j'ai le message suivant :

Un programme essaie d'accéder aux adresses de messagerie enregistrées dans outlook. L'autorisez vous à poursuivre ?

Si cette action est inattendue, il se peut qu'il s'agisse d'un virus dans ce cas, chosissez non, autorisez oui non annuler

ce message apparait pour chaque message ????

Sinon, j'ai deux autres petit souci que je n'arrive pas à résoudre :

- il ne me reconnait pas les adresses interne de ma société, car elle apparaisse en Nom, Prénom, et non pas avec l'adresse mail.

- j'aimerais également établir une règle à partir du contenu de l'objet, avez le code ?

merci.

meumeu73.1

[meumeu73.1]

Re Bonjour,

je n'ai plu le fameux message, j'ai trouvé pour qu'il me reconnaissent le Nom, Prénom.


Par contre, je n'ai pas trouvé :

- j'aimerais également établir une règle à partir du contenu de l'objet, avez le code ?

[Oliv-]

SAlut,
il faut tester MyMail.subject

[meumeu73.1]

Merci, je teste.

[meumeu73.1]

Bonjour,

J'ai testé MyMail.Subject, ça fonctionne très bien à partir du moment ou l'objet correspond exactement à ce que l'on a défini dans le script.

Existe t il un moyen de dire dans le script : contient le mot "Coucou" et non pas strictement "coucou".

Par avance merci

meumeu73.1

[Laurent CUENET]

Il suffit de transformer le tout en Majuscule pour faire la comparaison avec la fonction UCase().

A bientôt

[meumeu73.1]

En fait, je viens de trouver une parade. voici le script définitif pour ceux qui sont interessé :

Code :

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
Sub Script_move(MyMail As Outlook.MailItem)
'
' après avoir inscrit le script dans le VBE sous "ThisOutlookSession"
' créer la règle de messagerie éxécuter le script avec l'exception
' sauf s'il s'agit d'une mise à jour ou une invitation à une réunion
' Et voilà.....
'
    Dim myOlApp As New Outlook.Application
    Dim myNameSpace As Outlook.NameSpace
 
    Set myNameSpace = myOlApp.GetNamespace("MAPI")
 
    DestinationName = ""  'répertoire dans le dossier perso
    DestinationName2 = "" 'sous répertoire dans le dossier perso
 
'>>>>>>>>>>> Selection Par adresse mail<<<<<<<<<<<
 
    Select Case MyMail.SenderEmailAddress
 
        Case "machin.truc@madnarine.fr", "truc.machin@blabla.com"
            DestinationName = "Amis"
        Case Else
            DestinationName = ""
            DestinationName2 = ""
    End Select
 
'>>>>>>>>>>> Selection Par Nom du mail<<<<<<<<<<<
 
    Select Case MyMail.SenderName
 
        Case "Dupont, fernand", "Martin, Jacques"
            DestinationName = "Collègues"
 
        Case Else
            DestinationName = ""
            DestinationName2 = ""
    End Select
 
'>>>>>>>>>>> Selection Par Objet du mail<<<<<<<<<<<
 
    If InStr(LCase(MyMail.Subject), LCase("[Coucou2]")) <> 0 Then
        DestinationName = "Coucou"
        DestinationName2 = "Coucou2"
    ElseIf etc....
 
    End If
 
'>>>>>>>>>>> Déplacement des mails<<<<<<<<<<<
 
    If DestinationName <> "" And DestinationName2 = "" Then
        Set MyDestinationFolder = myNameSpace.Folders("Dossiers perso").Folders(DestinationName)
        MyMail.Move MyDestinationFolder
    ElseIf DestinationName <> "" And DestinationName2 <> "" Then
        Set MyDestinationFolder = myNameSpace.Folders("Dossiers perso").Folders(DestinationName).Folders(DestinationName2)
        MyMail.Move MyDestinationFolder
    Else
        Set MyDestinationFolder = myNameSpace.Folders("Dossiers perso").Folders("Boîte de réception")
        MyMail.Move MyDestinationFolder
    End If
 
End Sub

Par contre, apparemment, j'ai toujours le message :

Un programme essaie d'accéder aux adresses de messagerie enregistrées dans outlook. L'autorisez vous à poursuivre ?

Si cette action est inattendue, il se peut qu'il s'agisse d'un virus dans ce cas, chosissez non, autorisez oui non annuler

je n'ai pas retester, j'attends de recevoir des mails qui ne sont pas dans le script.

[Laurent CUENET]

re-Bonjour,

Tu dois utiliser un programme tiers du type :

http://www.mapilab.com/outlook/security/

C'est le plus efficace

A bientôt

[meumeu73.1]

en effet, impéccable merci, bonne journée.

Encore merci à tous ceux qui m'ont aidé.

[Oliv-]

Tu peux effectivement utiliser un programme qui va cliquer à ta place, il y a aussi clickyes mais ca peut ouvrir une breche dans la sécurité, mais le programme cité par Laurent est pas mal car tu peux le paramétrer selon les applications,
Les messages de sécurité arrivent lorsque l'on fait certaines actions (send par exemple ) ou que l'on consulte certaines propriétés ou lorsque c'est un autre programme qui se connecte
Il faut donc revoir ton code

Cela vient de cette ligne :

Code :

1
2
 
Dim myOlApp As New Outlook.Application

et plus particulièrement du "new"

[Laurent CUENET]

Pour continuer en matière de sécurité,

L'accès à certaine information dans Outlook 200x comme les champs ou l'accès à certaines fonctionnalités d'envoi de mail sont bloqués car utiliser par des virus pour ce propager.

En plus du programme que je vous ai proposé,il y a aussi cette solution réservé à 2007.

Sécurité Outlook 2007

A bientôt,

[Oliv-]

Et pour revenir sur la comparaison de chaine il y a aussi
"like" mais attention aux majuscules et minuscules.(Option Compare Text)
on peut aussi tout mettre en majuscules :

If Not UPPER(Sujet) Like "*TOTO : *" Then