Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean) 'Pour publipostage avec 'PJ OUTLOOK IDENTIQUE POUR TOUS LES MAILS 'ou INDIVIDUELLE PAR DESTINAIRE 'ou ENVOI DE MAIL INDIVIDUALISES EN GROUPE A UNE MEME ADRESSE MAIL Dim objFolder As Object Dim objFile As Object If Item.Class = olMail Then Dim objCurrentMessage As MailItem Set objCurrentMessage = Item If UCase(objCurrentMessage.Subject) Like "*PUBLIIDEM*" Then On Error Resume Next 'Pour ajouter la même PJ à tous Dim i As Long i = 0 If publipostagePJ <> "" Then While publipostagePJ(i) <> "fin" objCurrentMessage.Attachments.Add Source:=publipostagePJ(i) i = i + 1 Wend End If 'On supprime le terme PUBLIIDEM du sujet objCurrentMessage.Subject = Replace(objCurrentMessage.Subject, "PUBLIIDEM ", "") ElseIf UCase(objCurrentMessage.Subject) Like "*PUBLIPERSO*" Then 'Pour ajouter une ou des PJ personalisées contenant l'adresse email dans leur nom 'déclaration du scripting.filesystemobjet pour parcourir les dossiers Set objFSO = CreateObject("Scripting.FileSystemObject") '----------------On précise le chemin du dossier contenant les documents sans oublier l'\ à la fin -------------- Set objFolder = objFSO.GetFolder("C:\Users\Patricia\Desktop\PJ\") 'parcours chaque fichier du dossier For Each objFile In objFolder.Files ' test pour savoir si le nom contient l'email du destinataire et l'ajoute en PJ If objFile.Name Like "*" & objCurrentMessage.To & "*" Then objCurrentMessage.Attachments.Add Source:=objFile.Path End If Next objFile 'On supprime le terme PUBLIPERSO du sujet objCurrentMessage.Subject = Replace(objCurrentMessage.Subject, "PUBLIPERSO ", "") 'On sauvegarde le mail objCurrentMessage.Save End If Set objCurrentMessage = Nothing End If End Sub