Roln1k

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

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

Ce code sera à placer dans "ThisOutlookSession"

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

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
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

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 !