Bonjour,
Contexte :
Je souhaite faire un emailing en utilisant outlook 2007. Pour ce faire, il faut utiliser l’outil publipostage de Word, qui nous permet ensuite d’envoyer vers outlook. Jusque-là pas de problème il s’agit d’un simple publipostage.
Problème :
Or, je souhaite que ce publipostage contienne une pièce jointe. La fonction Publipostage avec pièce(s) jointe(s) n'est pas prévue dans Word. Il est donc impossible de réaliser la chose par le système classique.
J’ai trouvé une solution sur le Web, cette solution est purement Outlook et passe par VBA.
Cette macro a été écrite par Oliv' et est extraite de la FAQ Outlook : Lien : http://www.faqword.com/index.php/word-tutoriels/toutes-versions/670-publipostage-et-pj.html?pageNumber=1&pageNumber=0#udjaCommentsWrapper
J’ai les codes suivants, voyez vous une erreur ?
- This look session:
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
'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
- Module 1:
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 choisir un fichier à joindre ?", 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("C:\Users\svoisin\Desktop\b.xlsx")
If "" = Dir(PJ, vbNormal) Then GoTo quest
publipostagePJ(i) = PJ
Else: Exit For
End If
Next i
End If
End Sub
Je vous remercie par avance pour ce que vous pourrez faire / répondre.