Mettre automatiquement un utilisateurs en copie d'un mail selon le domaine mail du destinataire
par
, 07/04/2015 à 09h33 (776 Affichages)
Salut,
Tout d’abord laissez moi vous prévenir que je suis bieeeeen loin d'être un développeur expert, je connais la base et sais me servir de google
Voici un script Outlook qui permet d'automatiquement ajouter un utilisateur en copie d'un mail, selon le destinataire du mail (notamment son domaine). Il s'agit d'un de mes de sujet de stage or vu qu'un utilisateur ( Oliv' ) m'a énormément aidé, je me suis dit que j'allais partager, sait-on jamais, ça peut être utile .
Que va faire ce code ?
Pour faire simple, si l'utilisateurs envoie un mail à exemple@domainA.fr, le code va regarder un fichier texte où son préciser les liens entre utilisateurs et regarder quel est celui en lien avec domainA.fr. Ici, ce sera l'utilisateur B qui va alors être mis en copie (ok, c'ets confus, mais je vous promet que ça va être plus clair).
Application pratique:
Un technicien envoie un mail à client@domain1.fr, le commercial de l'entreprise en charge de ce client sera mis en copie. Ce qui peut permettre un certain suivi. Si le même technicien envoie un mail à client@domain2.com ce sera un autre commercial ui sera mis en copie.
Le code:
Voici à quoi doit ressembler le fichier texte
Ce code sera à placer dans "ThisOutlookSession"
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3 domaine1.fr;commercial1@entreprise.fr domaine2.fr;commercial1@entreprise.fr domaine3.fr;commercial2@entreprise.fr
Et à mettre dans Module1
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 Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean) 'By Oliv' 29/06/2007 pour Outlook 2003 'Modifié par Roln1k le 07/04/2015 If Not Item.Class = olMail Then GoTo fin Dim prompt As String '########################correspondance CC selon destinataire############################## Dim recip As Outlook.Recipient Dim sDomain As String Dim arTemp As Variant Alimente_Liste Set recip = Item.Recipients(1) arTemp = Split(recip.Address, "@", , vbTextCompare) sDomain = arTemp(1) cci = Get_Cial(sDomain) '########################Option CC############################## prompt = "Ajouter le cc " & cci & " à " & Item.Subject & "?" If MsgBox(prompt, vbYesNo + vbQuestion, "Sample") = vbYes Then Set myRecipient = Item.Recipients.Add(cci) myRecipient.Type = olCC myRecipient.Resolve If myRecipient.Resolved = False Then MsgBox "L'adresse Email n'est pas correcte !", vbCritical, "Erreur" Cancel = True End If End If '#######################FIN##################################### fin: End Sub
Voilà, c'est mon premier billet, c'est brouillon mais j'espère que ça pourra aider et je suis dispo pour toute question, même si je dois énormément à Oliv' sans qui je n'aurais pu réussir !
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 Public MyArray() Sub Test_Get_Cial() Call Alimente_Liste MsgBox Get_Cial("exemple1.fr") End Sub Sub Alimente_Liste() Dim intFic As Integer Dim strLigne As String Dim i As Integer i = 0 intFic = FreeFile Open "C:\Users\...\Domaine-Cial.txt" For Input As intFic i = 0 While Not EOF(intFic) Line Input #intFic, strLigne ReDim Preserve MyArray(i) MyArray(i) = strLigne i = i + 1 Wend Close intFic End Sub Function Get_Cial(Email) As String Get_Cial = "" For i = 0 To UBound(MyArray) If Split(MyArray(i), ";", , vbTextCompare)(0) = Email Then Get_Cial = Split(MyArray(i), ";", , vbTextCompare)(1) Exit For End If Next i End Function