automatisation de l'insertion du signature en fonction d'un objet

**antony34200** · 07/06/2020, 00h06

Bonjour,
dans le cadre de mon travail, je me retrouve a devoir envoyer plusieurs mails, avec le même objet à différent et multiple contacts.

1) Est-il possible d'automatisé une signature en fonction de l'objet ??

Par exemple :
Objet => contrat semaine XX (XX = le numéro de la semaine)
insertion automatique de la signature que j'ai nommé contrat

ou
Objet = salaire mois de XXXXX
Insertion automatique de la signature que j'ai nommé salaire

2) Et est-il possible d'automatiser l'insertion des PJ du contact en fonction de son adresse mail??

Par exemple :
je dois envoyer un fichier ou plusieurs fichiers PDF, qui sont dans un dossier nommé (A ENVOYER), à mon contact.
A la saisie de son mail, contact@xxx.xxx, l'insertion des fichier contenant son nom soient automatiquement insérés.
Tous mes fichiers PDF son nommé par le nom de mon contact au début (contact_cl_23_m.pdf)

Merci par avance.

**Oliv-** · 08/06/2020, 14h55

Bonjour,

Plusieurs façons de déclencher la macro, le plus simple c'est à l'envoi en utilisant application_itemsend()

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
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
 
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
'---------------------------------------------------------------------------------------
' Procedure : Application_ItemSend
' Author    : OCTU
'---------------------------------------------------------------------------------------
'
    If Not Item.Class = olMail Then GoTo fin
'on teste le sujet
    If InStr(1, Item.subject, "contrat semaine", vbTextCompare) Then
        '   voir ici
        '   https://www.developpez.net/forums/blogs/191381-oliv/b4076/inserer-signature-lemail-actif-outlook-2016
        Call InsertSignature(Item, "contrat")
        Item.Save
    ElseIf InStr(1, Item.subject, "salaire mois de", vbTextCompare) Then
 
        Call InsertSignature(Item, "salaire")
        Item.Save
 
    End If
 
    'on ajoute des PJ selon l'adresse Email du premier destinataire
 
    EmailDest = split(GetSMTPAddressForRecipient (Item.Recipients(1)),"@")(0)
    Dim MonDossierPJ
    MonDossierPJ = "c:\temp\a envoyer\"
 
    Set Fso = CreateObject("Scripting.FileSystemObject")
    Set AFolder = Fso.GetFolder(MonDossierPJ)
 
 
    For Each Afile In AFolder.Files
 
        If InStr(1, Afile, EmailDest, vbTextCompare) > 0 Then
            Item.Attachments.Add Source:=Afile.Path
        End If
    Next Afile
 
fin:
End Sub
 
'   voir ici
'   https://www.developpez.net/forums/blogs/191381-oliv/b4076/inserer-signature-lemail-actif-outlook-2016
 
Function GetSMTPAddressForRecipient(recip As Outlook.Recipient) As String
'---------------------------------------------------------------------------------------
' Procedure : GetSMTPAddressForRecipient
' Author    : Oliv-
' Date      : 21/01/2015
' Purpose   : Obtenir l'adresse SMTP =xxx@xxx.xxx
'---------------------------------------------------------------------------------------
'Dim recip As Outlook.Recipient
'pas de adresse SMTP si Contact d'origine EXCHANGE mais copié dans Pop
    GetSMTPAddressForRecipient = ""
    On Error GoTo Fin
    Dim PA As Outlook.propertyAccessor
    Const PR_SMTP_ADDRESS As String = _
          "http://schemas.microsoft.com/mapi/proptag/0x39FE001E"
    Set PA = recip.propertyAccessor
    'Debug.Print recip.Name & " SMTP=" _
     & pa.GetProperty(PR_SMTP_ADDRESS)
    GetSMTPAddressForRecipient = PA.GetProperty(PR_SMTP_ADDRESS)
Fin:
    If GetSMTPAddressForRecipient = "" Then GetSMTPAddressForRecipient = recip
End Function

**antony34200** · 08/06/2020, 17h45

Bonjour et merci pour votre réponse.
J'ai inséré le code dans ThisOutlookSession, et là, ... ca ne fonctionne pas ...
Ni la signature, ni l'insertion des PJ ...

**Oliv-** · 08/06/2020, 17h57

as tu ajouté la fonction signature ? en allant sur le lien vers le blog ?
les paramètres de sécurité concernant les macros sont ils ok ?

Y a un message d'erreur ?

**antony34200** · 08/06/2020, 18h01

Les macro sont bien activé, et j'ai copié bêtement le code que vous m'avez fourni et je n'ai aucun message d'erreur

**Oliv-** · 08/06/2020, 18h15

Essaye avec ce code qui comporte la partie signature

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
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
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
 
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
'---------------------------------------------------------------------------------------
' Procedure : Application_ItemSend
' Author    : OCTU
'---------------------------------------------------------------------------------------
'
    If Not Item.Class = olMail Then GoTo Fin
'on teste le sujet
    If InStr(1, Item.Subject, "contrat semaine", vbTextCompare) Then
        '   voir ici
        '   https://www.developpez.net/forums/blogs/191381-oliv/b4076/inserer-signature-lemail-actif-outlook-2016
        Call InsertSignature(Item, "perso")
        Item.Save
    ElseIf InStr(1, Item.Subject, "salaire mois de", vbTextCompare) Then
 
        Call InsertSignature(Item, "salaire")
        Item.Save
 
    End If
 
    'on ajoute des PJ selon l'adresse Email du premier destinataire
 
    EmailDest = Split(GetSMTPAddressForRecipient(Item.Recipients(1)), "@")(0)
    Dim MonDossierPJ
    MonDossierPJ = "c:\temp\a envoyer\"
 
    Set Fso = CreateObject("Scripting.FileSystemObject")
    Set AFolder = Fso.GetFolder(MonDossierPJ)
 
 
    For Each Afile In AFolder.Files
 
        If InStr(1, Afile, EmailDest, vbTextCompare) > 0 Then
            Item.Attachments.Add (Afile.Path)
        End If
    Next Afile
 
Fin:
End Sub
 
'   voir ici
'   https://www.developpez.net/forums/blogs/191381-oliv/b4076/inserer-signature-lemail-actif-outlook-2016
 
Function GetSMTPAddressForRecipient(recip As Outlook.Recipient) As String
'---------------------------------------------------------------------------------------
' Procedure : GetSMTPAddressForRecipient
' Author    : Oliv-
' Date      : 21/01/2015
' Purpose   : Obtenir l'adresse SMTP =xxx@xxx.xxx
'---------------------------------------------------------------------------------------
'Dim recip As Outlook.Recipient
'pas de adresse SMTP si Contact d'origine EXCHANGE mais copié dans Pop
    GetSMTPAddressForRecipient = ""
    On Error GoTo Fin
    Dim PA As Outlook.PropertyAccessor
    Const PR_SMTP_ADDRESS As String = _
          "http://schemas.microsoft.com/mapi/proptag/0x39FE001E"
    Set PA = recip.PropertyAccessor
    'Debug.Print recip.Name & " SMTP=" _
     & pa.GetProperty(PR_SMTP_ADDRESS)
    GetSMTPAddressForRecipient = PA.GetProperty(PR_SMTP_ADDRESS)
Fin:
    If GetSMTPAddressForRecipient = "" Then GetSMTPAddressForRecipient = recip
End Function
 
 
Sub InsertSignature(objMail As MailItem, SignatureName As String)
'---------------------------------------------------------------------------------------
' Procedure : InsertSignature
' Author    : OLiv
' Date      : 03/11/2017
' Purpose   : Ajout d'une signature pour OUTLOOK 2010,2013,2016
'---------------------------------------------------------------------------------------
'
    Dim wd As Object, obSelection As Object
    Dim enviro, strSigFilePath
    Const wdStory = 6
    Const wdParagraph = 4
    Const wdGoToBookmark = -1
    Const wdExtend = 1
    Const wdSortByName = 0
    enviro = CStr(Environ("appdata"))
    strSigFilePath = enviro & "\Microsoft\Signatures\"
 
 
    Set wd = objMail.GetInspector.WordEditor
    Set obSelection = wd.Application.Selection
    obSelection.Move wdStory, -1
 
    obSelection.Move wdParagraph, 1
    obSelection.Paragraphs.Add
    obSelection.Move wdParagraph, 1
 
    Dim oBookmark
    Set oBookmark = obSelection.Bookmarks.Add("_Sig", obSelection.Range)
 
    If Dir(strSigFilePath & SignatureName & ".htm", vbNormal) <> "" Then
        obSelection.InsertFile FileName:=strSigFilePath & SignatureName & ".htm", Range:="", ConfirmConversions:= _
                               False, Link:=False, Attachment:=False
 
        obSelection.GoTo What:=wdGoToBookmark, Name:="_Sig"
 
        obSelection.EndKey Unit:=wdStory, Extend:=wdExtend
        With wd.Bookmarks
            .Add Range:=obSelection.Range, Name:="_MailAutoSig"
            .DefaultSorting = wdSortByName
            .ShowHidden = False
        End With
 
        obSelection.Move wdStory, -1
    End If
End Sub

éventuellement il faut fermer\ouvrir OUTLOOK

**antony34200** · 08/06/2020, 18h24

J'ai lu les 2 méthodes. mon choix serais de prendre la seconde IMPORTE le fichier signature AVEC les images et permet de changer de Signature en utilisant le ruban, mais je ne sais pas ou l'importer.
Je ni comprend pas grand chose sur le VBA, a part le copier/coller et modifier les emplacements de fichier ...

**antony34200** · 08/06/2020, 18h30

ca ne fonctionne pas non plus ...
J'ai inséré le code puis fermé et ouvert OL, j'ai fait nouveau message, j'ai directement renseigné dans objet : salaire mois de Mai 2020, et rien, j'ai ma signature par defaut qui reste

**Oliv-** · 09/06/2020, 09h00

Bonjour,

Il faut bien copier le code dans ThisOutlookSession.

Pour voir s'il se déclenche bien
ajoutes sous la ligne ( If Not Item.Class = olMail Then GoTo Fin) STOP
et envois un Email tu devras faire F5 pour continuer ou cliquer sur l a flèche.

AS tu une Signature qui se met par défaut ?

**antony34200** · 09/06/2020, 15h25

Bonjour,
j'ai inseré
If Not Item.Class = olMail Then GoTo Fin
et j'ai pu envoyer le mail ...
cette formule était dejà dans le code que vous m'aviez passé précédement

**antony34200** · 09/06/2020, 15h26

Ouyi j'ai une signature par défaut

**Oliv-** · 09/06/2020, 15h32

Envoyé par antony34200

Bonjour,
j'ai inseré
If Not Item.Class = olMail Then GoTo Fin
et j'ai pu envoyer le mail ...
cette formule était dejà dans le code que vous m'aviez passé précédement

en fait il fallait ajouter le mot STOP après cette ligne !

J'ai modifié la fonction InsertSignature

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
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
Sub InsertSignature(objMail As MailItem, SignatureName As String)
'---------------------------------------------------------------------------------------
' Procedure : InsertSignature
' Author    : OLiv
' Version   : 2
' Date      : 09/06/2020
' Purpose   : Ajout d'une signature pour OUTLOOK 2010,2013,2016,365
'---------------------------------------------------------------------------------------
'
    Dim wd As Object, obSelection As Object
    Dim oBookmarks As Object, oBookmark As Object 'Word.Bookmark
    Dim enviro, strSigFilePath
    Const wdStory = 6
    Const wdParagraph = 4
    Const wdGoToBookmark = -1
    Const wdExtend = 1
    Const wdSortByName = 0
    enviro = CStr(Environ("appdata"))
    strSigFilePath = enviro & "\Microsoft\Signatures\"
 
 
    Set wd = objMail.GetInspector.WordEditor
 
    Set obSelection = wd.Application.Selection
 
    Set oBookmarks = wd.Bookmarks
 
    On Error Resume Next
    Set oBookmark = oBookmarks("_MailAutoSig")
    On Error GoTo 0
    If oBookmark Is Nothing Then
        Set obSelection = wd.Application.Selection
        obSelection.Move wdStory, -1
        obSelection.Move wdParagraph, 1
        obSelection.Paragraphs.Add
        obSelection.Move wdParagraph, 1
        Set oBookmark = obSelection.Bookmarks.Add("_MailAutoSig", obSelection.Range)
        oBookmark.Range.Text = "_Signature"
        oBookmark.End = wd.Range.End
    End If
 
    If Dir(strSigFilePath & SignatureName & ".htm", vbNormal) <> "" Then
 
        'oBookmark.Select
        Dim orng As Object 'Word.Range
        Set orng = wd.Range
        orng.Start = orng.Bookmarks("_MailAutoSig").Range.Start
        orng.End = orng.Bookmarks("_MailAutoSig").Range.End
        orng.InsertFile FileName:=strSigFilePath & SignatureName & ".htm", Range:="", ConfirmConversions:= _
                        False, Link:=False, Attachment:=False
        orng.End = wd.Range.End
        With wd.Bookmarks
            .Add Range:=orng, Name:="_MailAutoSig"
            .DefaultSorting = wdSortByName
            .ShowHidden = False
        End With
 
        'On Error Resume Next
        'Set oBookmark = wd.Bookmarks("_MailAutoSig")
        ' oBookmark.End = wd.Range.End
        'oBookmark.Select
 
        obSelection.Move wdStory, -1
    End If
End Sub

**Oliv-** · 09/06/2020, 15h47

aux lignes 13 et 17 du #6 IL FAUT ADAPTER SELON TES SIGNATURES

AINSI qu'à la ligne 26

**antony34200** · 09/06/2020, 20h31

Bonjour,
J'avais bien modifié les lignes 13, 17 et 26.
J'ai mis votre code et ça ne marche toujours pas... J'ai fermé puis réouvert OL, mais toujours pareil, ca ne fonctionne pas.

Voila le code que j'ai mis dans ThisOutloockSession :

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
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
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
'---------------------------------------------------------------------------------------
' Procedure : Application_ItemSend
' Author    : OCTU
'---------------------------------------------------------------------------------------
'
    If Not Item.Class = olMail Then GoTo Fin
'on teste le sujet
    If InStr(1, Item.Subject, "contrat semaine", vbTextCompare) Then
        '   voir ici
        '   <a href="https://www.developpez.net/forums/blogs/191381-oliv/b4076/inserer-signature-lemail-actif-outlook-2016" target="_blank">https://www.developpez.net/forums/bl...f-outlook-2016</a>
        Call InsertSignature(Item, "contrat")
        Item.Save
    ElseIf InStr(1, Item.Subject, "salaire mois de", vbTextCompare) Then
 
        Call InsertSignature(Item, "salaire")
        Item.Save
 
    End If
 
    'on ajoute des PJ selon l'adresse Email du premier destinataire
 
    EmailDest = Split(GetSMTPAddressForRecipient(Item.Recipients(1)), "@")(0)
    Dim MonDossierPJ
    MonDossierPJ = "C:\Users\PC - Bureau\Desktop\a envoyer\"
 
    Set Fso = CreateObject("Scripting.FileSystemObject")
    Set AFolder = Fso.GetFolder(MonDossierPJ)
 
 
    For Each Afile In AFolder.Files
 
        If InStr(1, Afile, EmailDest, vbTextCompare) > 0 Then
            Item.Attachments.Add (Afile.Path)
        End If
    Next Afile
 
Fin:
End Sub
 
'   voir ici
'   <a href="https://www.developpez.net/forums/blogs/191381-oliv/b4076/inserer-signature-lemail-actif-outlook-2016" target="_blank">https://www.developpez.net/forums/bl...f-outlook-2016</a>
 
Function GetSMTPAddressForRecipient(recip As Outlook.Recipient) As String
'---------------------------------------------------------------------------------------
' Procedure : GetSMTPAddressForRecipient
' Author    : Oliv-
' Date      : 21/01/2015
' Purpose   : Obtenir l'adresse SMTP =xxx@xxx.xxx
'---------------------------------------------------------------------------------------
'Dim recip As Outlook.Recipient
'pas de adresse SMTP si Contact d'origine EXCHANGE mais copié dans Pop
    GetSMTPAddressForRecipient = ""
    On Error GoTo Fin
    Dim PA As Outlook.PropertyAccessor
    Const PR_SMTP_ADDRESS As String = _
          "http://schemas.microsoft.com/mapi/proptag/0x39FE001E"
    Set PA = recip.PropertyAccessor
    'Debug.Print recip.Name & " SMTP=" _
     & pa.GetProperty(PR_SMTP_ADDRESS)
    GetSMTPAddressForRecipient = PA.GetProperty(PR_SMTP_ADDRESS)
Fin:
    If GetSMTPAddressForRecipient = "" Then GetSMTPAddressForRecipient = recip
End Function
 
 
Sub InsertSignature(objMail As MailItem, SignatureName As String)
'---------------------------------------------------------------------------------------
' Procedure : InsertSignature
' Author    : OLiv
' Version   : 2
' Date      : 09/06/2020
' Purpose   : Ajout d'une signature pour OUTLOOK 2010,2013,2016,365
'---------------------------------------------------------------------------------------
'
    Dim wd As Object, obSelection As Object
    Dim oBookmarks As Object, oBookmark As Object 'Word.Bookmark
    Dim enviro, strSigFilePath
    Const wdStory = 6
    Const wdParagraph = 4
    Const wdGoToBookmark = -1
    Const wdExtend = 1
    Const wdSortByName = 0
    enviro = CStr(Environ("appdata"))
    strSigFilePath = enviro & "\Microsoft\Signatures\"
 
 
    Set wd = objMail.GetInspector.WordEditor
 
    Set obSelection = wd.Application.Selection
 
    Set oBookmarks = wd.Bookmarks
 
    On Error Resume Next
    Set oBookmark = oBookmarks("_MailAutoSig")
    On Error GoTo 0
    If oBookmark Is Nothing Then
        Set obSelection = wd.Application.Selection
        obSelection.Move wdStory, -1
        obSelection.Move wdParagraph, 1
        obSelection.Paragraphs.Add
        obSelection.Move wdParagraph, 1
        Set oBookmark = obSelection.Bookmarks.Add("_MailAutoSig", obSelection.Range)
        oBookmark.Range.Text = "_Signature"
        oBookmark.End = wd.Range.End
    End If
 
    If Dir(strSigFilePath & SignatureName & ".htm", vbNormal) <> "" Then
 
        'oBookmark.Select
        Dim orng As Object 'Word.Range
        Set orng = wd.Range
        orng.Start = orng.Bookmarks("_MailAutoSig").Range.Start
        orng.End = orng.Bookmarks("_MailAutoSig").Range.End
        orng.InsertFile FileName:=strSigFilePath & SignatureName & ".htm", Range:="", ConfirmConversions:= _
                        False, Link:=False, Attachment:=False
        orng.End = wd.Range.End
        With wd.Bookmarks
            .Add Range:=orng, Name:="_MailAutoSig"
            .DefaultSorting = wdSortByName
            .ShowHidden = False
        End With
 
        'On Error Resume Next
        'Set oBookmark = wd.Bookmarks("_MailAutoSig")
        ' oBookmark.End = wd.Range.End
        'oBookmark.Select
 
        obSelection.Move wdStory, -1
    End If
End Sub

**antony34200** · 09/06/2020, 20h40

alors si la signature fonctionne, il fallais que j'envoi le mail, je pensais que la signature allais se changer pour visualisation ...
Par contre, les documents a envoyer ne se sont pas envoyés ...

**antony34200** · 09/06/2020, 20h56

si je répond à un mail
RE : Salaire mois de XXXX
J'ai un message d'erreur :
Erreur d’exécution 5941 :
Le membre de la collection requis n'existe pas.

en cliquant sur fin, le mail part quand même en écrivant "_Signature" juste avant ma signature par défaut

**Oliv-** · 10/06/2020, 12h08

Bonjour,
je vais regarder cela.

Pour l'ajout des pièces jointes , il prend dans le dossier indiqué toutes fichiers qui commencent par la partie avant l'@

exemple jean.dupont@toto.fr

jean.dupontdocument1.pdf

**Oliv-** · 10/06/2020, 12h09

tu veux limiter aux nouveaux EMAILS ? l'insertion de la signature et des pj ?

**antony34200** · 10/06/2020, 14h10

Bonjour,
oui, j'aimerais limiter qu'au nouveau message l'insertion de la signature et l'ajout des PJ.

Mes contacts sont nommés : voir la photo ci-dessous. et à la création du nouveau mail, j'appelle mes contacts par le bouton A...

Nom : Capture.PNG
Affichages : 231
Taille : 8,9 Ko

Nom : Capture.PNG
Affichages : 231
Taille : 8,9 Ko

Et les pièces à joindre : DUPONT Jdocument.pdf (la première lettre du prénom est noté dans le nom du document uniquement si j'ai d'autre document avec le même nom)
Ex :
DUPONT Jdocument.pdf (pour DUPONT Jean)
DUPONT Cdocument.pdf (pour DUPONT Charles)

**Oliv-** · 10/06/2020, 14h36

Voici une maj pour ne traiter que les nouveaux emails

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
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
'---------------------------------------------------------------------------------------
' Procedure : Application_ItemSend
' Author    : OCTU
'---------------------------------------------------------------------------------------
'
    If Not Item.Class = olMail Then GoTo Fin
    If Item.ReceivedByName <> "" Or Item.Sent = True Or Item.ConversationTopic <> "" Then GoTo Fin
    'on teste le sujet
    If InStr(1, Item.Subject, "contrat semaine", vbTextCompare) Then
        '   voir ici
        '   https://www.developpez.net/forums/blogs/191381-oliv/b4076/inserer-signature-lemail-actif-outlook-2016
        Call InsertSignature(Item, "contrat")
        Item.Save
    ElseIf InStr(1, Item.Subject, "salaire mois de", vbTextCompare) Then
 
        Call InsertSignature(Item, "salaire")
        Item.Save
 
    End If
 
    'on ajoute des PJ selon l'adresse Email du premier destinataire
    Dim EmailDest
    EmailDest = Split(GetSMTPAddressForRecipient(Item.Recipients(1)), "@")(0)
    Dim MonDossierPJ
    MonDossierPJ = "c:\temp\a envoyer\"
    Dim fso, AFolder, Afile
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set AFolder = fso.GetFolder(MonDossierPJ)
 
 
    For Each Afile In AFolder.Files
 
        If InStr(1, Afile, EmailDest, vbTextCompare) > 0 Then
            Item.Attachments.Add (Afile.Path)
        End If
    Next Afile
 
Fin:
End Sub

c'est la ligne
EmailDest = Split(GetSMTPAddressForRecipient(Item.Recipients(1)), "@")(0)
qu'il faut adapter si les documents ne contiennent pas la partie avant l'@

automatisation de l'insertion du signature en fonction d'un objet

Outlook

Discussions similaires

Partager

Partager