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
| 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\TheBa\OneDrive\Bureau\Test publipostage\Publi test 2\")
'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 |
Partager