R15320 [VBA] PUBLIPOSTAGE avec Pièces jointes
Publié par Oliv le Vendredi 16 février 2007 11:06

Ici le sujet doit CONTENIR "publipostage" mais on peut mettre autre chose.

 

Pour ajouter une pièce jointe différente pour chaque destinataire :

que l'on recherchera dans le HTMLBODY ou BODY du mail.

Sinon la macro OUTLOOK ci-dessous utilise une variable tableau GLOBALE qu'il faut initialiser en lancant setPublipostage

Mettre dans ThisOutlookSession :



Private Sub Application_ItemSend(ByVal Item As Object, Cancel As _
Boolean)
'by oliv' 05/02/2007 Pour publipostage avec PJ OUTLOOK 2003

If Item.Class = olMail Then
Dim objCurrentMessage As MailItem
Set objCurrentMessage = Item
If UCase(objCurrentMessage.Subject) Like "*PUBLIPOSTAGE*" 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
'Pour ajouter une PJ à tous décommenter
'objCurrentMessage.Attachments.Add Source:= _
"c:\temp\DOC2.PDF"
'#perso#Pour ajouter un document personnalisé d'après le destinataire _
du mail décommenter ci-dessous
' ici le nom du document est "
destinataire@domaine.fr.doc"
'docperso = "c:\temp\monmailing\" & objCurrentMessage.To & ". _
doc"
'objCurrentMessage.Attachments.Add Source:=docperso

'On supprime le terme PUBLIPOSTAGE du sujet

objCurrentMessage.Subject = Replace(objCurrentMessage.Subject, _
"PUBLIPOSTAGE ", "")
'On sauvegarde le mail
objCurrentMessage.Save
End If
Set objCurrentMessage = Nothing
End If
End Sub

 



Mettre dans un module :



Public publipostagePJ As Variant

Sub setPublipostage()
On Error Resume Next
If publipostagePJ(0) = "" Then publipostagePJ = Array("fin", "fin", "fin", "fin", "fin", "fin", "fin", "fin", "fin", "fin")
While publipostagePJ(i) <> "fin"
contenu = contenu & vbCr & publipostagePJ(i)
i = i + 1
Wend
If contenu = "" Then contenu = "vide"
modifier = MsgBox(contenu & vbCr & "Voulez vous modifier les fichiers ?", vbYesNo, "Fichiers paramétrés")
If modifier = vbYes Then
For i = 0 To 9

If i > 0 Then encore = MsgBox("un autre ?", vbYesNo)
quest:
If encore <> vbNo Then
PJ = InputBox("Emplacement du fichier joint au PUBLIPOSTAGE?", _

"Paramétrage du PUBLIPOSTAGE pour la session", publipostagePJ(i))

If "" = Dir(PJ, vbNormal) Then GoTo quest

publipostagePJ(i) = PJ
Else: Exit For
End If
Next i

End If
MsgBox "Votre publipostage doit comporter le terme :" & vbCr & _

"PUBLIPOSTAGE" & vbCr & "dans le sujet." & vbCr & _

"Celui-ci sera retiré lors de l'envoi"

End Sub

 


Vous pouvez retrouver le tutos complet pour mettre en place cette macro sur la FAQ Word