Le publipostage avec Pièce jointe n'existe pas dans Word. Cela étant, il n'est quand même pas impossible de faire un envoi en nombre si l'adresse du destinataire est aisément récupérable.
Donc, il ne s'agit pas ici d'un réel publipostage, mais voici trois macros qui vont envoyer un message à un groupe de personnes avec un fichier spécifique pour chacune d'elle. Ces macros auront besoin de critères concernant le destinataire. Voici donc trois types de critères différents :
- Pour la première macro, on part du principe que le nom du fichier correspond au nom du destinaire et que ces destinataires sont tous dans la même entreprise et donc sur le même domaine, auquel cas on pourra ajouter le nom de domaine au nom du fichier pour envoyer le mail.
- Pour la seconde, on imagine que l'adresse mail du destinataire figure dans le document à joindre, auquel cas il faudra simplement récupérer cette adresse.
- La troisième macro va chercher, dans un fichier de correspondance, l'adresse mail et le fichier à joindre. Cela est plus proche du principe de publipostage. On pourrait effectivement ajouter d'autres colonnes et récupérer les données dans la macro afin de les ajouter dans le texte ou l'objet du mail.
Attention, ces deux macros ne fonctionnent qu'avec Outlook de la suite Office.
Première macro : nom fichier = adresse mail
Public Sub envoi_groupe1()
'envoie une série de fichiers
'dont le nom est la première partie d'une adresse mail
Dim vFichier As Variant
Dim NbFichOK As Integer
Dim adresse As String, nom As String
' 1- Sélection des fichiers
' sélectionner les fichiers avec Maj ou Ctrl ou tous les fichiers avec Ctrl+A ou à la souris
Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogFilePicker)
fd.Title = "BATCH: Sélectionner les fichiers à envoyer"
fd.Filters.Add "Documents", "*.doc; *.dot; *.docx; *.docm; *.dotm; *.dotx; *.rtf", 1
If fd.Show <> -1 Then Exit Sub
If MsgBox(fd.SelectedItems.Count & " documents à traiter ", vbYesNo, "continuer ?") = vbNo Then Exit Sub
' 2- boucle tous les fichiers sélectionnés
For Each vFichier In fd.SelectedItems
nom = Right(vFichier, Len(vFichier) - InStrRev(vFichier, "\"))
adresse = Left(nom, Len(nom) - 5) & "@masociete.com"
On Error GoTo Fin
'====================================
'3 - Automation Outlook
Dim ol As Object, monItem As Object, mondoc
Set ol = CreateObject("outlook.application")
Set monItem = ol.CreateItem(0)
monItem.Subject = "Sujet du mail"
monItem.Body = "Bonjour" & Chr(13) & Chr(13) & "Texte du mail..."
Set mondoc = monItem.attachments
mondoc.Add vFichier
monItem.to = adresse
monItem.Send
Set ol = Nothing
NbFichOK = NbFichOK + 1
Fin:
Next vFichier
' 4 fin de la Macro
MsgBox ("La macro a été exécutée sur " & NbFichOK & " Fichiers")
Set fd = Nothing
End Sub
Deuxième macro - l'adresse mail est le premier paragraphe du document à joindre
Cet exemple utilise le premier paragraphe. À vous d'indiquer quel est le numéro du paragraphe. Il faut juste que l'adresse se trouve au même endroit, pour tous les documents. Attention toutefois, je déconseille d'essayer d'obtenir l'adresse si elle ne fait pas l'objet d'un paragraphe complet, d'une fin de paragraphe, ou d'une cellule de tableau. En effet, pour Word, une adresse mail est composée d'au moins 5 mots (nom, arobase, domaine, point, extension). Et donc le nombre total de mots va dépendre du nom. Ce sera néanmoins possible si, par exemple, l'adresse est la fin d'un paragraphe et toujours précédée par le même texte (Adresse mail :
Public Sub envoi_groupe2()
'envoie une série de fichiers
'dont l'adresse mail est le premier paragraphe du document
Dim vFichier As Variant, Fichier As Variant
Dim NbFichOK As Integer
Dim adresse As String
' 1- Sélection des fichiers
' sélectionner les fichiers avec Maj ou Ctrl ou tous les fichiers avec Ctrl+A ou à la souris
Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogFilePicker)
fd.Title = "BATCH: Sélectionner les fichiers à envoyer"
fd.Filters.Add "Documents", "*.doc; *.dot; *.docx; *.docm; *.dotm; *.dotx; *.rtf", 1
If fd.Show <> -1 Then Exit Sub
If MsgBox(fd.SelectedItems.Count & " documents à traiter ", vbYesNo, "continuer ?") = vbNo Then Exit Sub
' 2- boucle tous les fichiers sélectionnés
For Each vFichier In fd.SelectedItems
Set Fichier = GetObject(vFichier)
adresse = Fichier.Paragraphs(1)
On Error GoTo Fin
'====================================
'3 - Automation Outlook
Dim ol As Object, monItem As Object, mondoc
Set ol = CreateObject("outlook.application")
Set monItem = ol.CreateItem(0)
monItem.Subject = "Sujet du mail"
monItem.Body = "Bonjour" & Chr(13) & Chr(13) & "Texte du mail..."
Set mondoc = monItem.attachments
mondoc.Add vFichier
monItem.to = adresse
monItem.Send
Set ol = Nothing
Fichier.Close
NbFichOK = NbFichOK + 1
Fin:
Next vFichier
' 4 fin de la Macro
MsgBox ("La macro a été exécutée sur " & NbFichOK & " Fichiers")
Set fd = Nothing
End Sub
Troisième macro : fichier de correspondance
Pour faire fonctionner cette troisième macro, vous devez, au préalable, créer un fichier Word dans lequel vous copierez cette macro. Ce fichier sera composé d'un tableau de deux colonnes. Dans la première colonne figurera le nom complet du fichier à joindre, avec son chemin (C:/Documents/mon_dossier/toto.docx), et dans la seconde l'adresse mail.
Comme précisé en début d'article, rien ne vous empêche d'utiliser un tableau avec plus de colonnes et donc plus de données. Ainsi vous pourrez même utiliser dans le mail le contenu de chacune des colonnes, à l'image d'un véritable publipostage, afin d'envoyer des mails personnalisés.
Notez que j'utilise ici un tableau Word parce qu'ici c'est la Faqword ! On pourrait utiliser un tableau Excel, auquel cas, il faudrait créer une macro Excel avec automation Outlook.
Vous pouvez aussi bêtement recopier votre tableau Excel et en faire un tableau Word.
Public Sub envoigroupe4()
'envoie une série de fichiers
'en partant d'un tableau Word
Dim Fichier As Variant
Dim NbFichOK As Integer
Dim adresse As String
Dim n_fichier As String, n_adresse, ligne
Dim outlookMail As Object, OutlookApp As Object
Application.ScreenUpdating = False
For Each ligne In ActiveDocument.Tables(1).Rows
Fichier = Len(ligne.Cells(1).Range.Text)
n_fichier = Left(ligne.Cells(1), Fichier - 2)
adresse = Len(ligne.Cells(2).Range.Text)
n_adresse = Left(ligne.Cells(2), adresse - 2)
Set OutlookApp = CreateObject("outlook.application")
Set outlookMail = OutlookApp.createitem(0)
With outlookMail
.Subject = "Sujet du mail" 'saisir le sujet du message
.attachments.Add n_fichier
.to = n_adresse
.Body = "Bonjour" & Chr(13) & Chr(13) & "Texte du mail..."
.Display
.send
End With
NbFichOK = NbFichOK + 1
Next ligne
MsgBox ("La macro a été exécutée sur " & NbFichOK & " Fichiers")
End Sub