Publipostage Excel/Word avec pièce jointe

Fred 33

XLDnaute Nouveau
Bonjour à tous, je remercie beaucoup d'entres vous qui m'ont aidés à leur insu dans l'avancée du développement de mon outil sous Excel. J'arrive au bout mais je bute sur le publipostage. Je vois également que je ne suis pas seul dans ce cas.
J'aimerai faire du publipostage depuis Word. J'utilise Excel comme base de Données de fusion., cela marche très bien sauf que je n'ai pas trouvé le moyen de rajouter automatiquement une pièce jointe au document fusionné.
La macro ci dessous, fonctionne partiellement elle crée les documents avec la pièce jointe mais ne met pas à jour les champs de fusion du document principal.
Là, je galère+

Si quelqu'un a une idée, merci.

Sub Macro2() 'publipostageMailing_wordVBA_avecPieceJointe()
'michelxld le 03.03.2006
'
'Utilisez cette procédure après avoir créé et mis en forme votre document principal.
'C'est la macro qui va boucler sur tous les enregistrements et envoyer les mails et y ajouter une pièce jointe .
'Les adresses mail sont dans le champ "champMail" de la base de données .
'Cet exemple ne prend pas en compte les filtres éventuels dans le publipostage .
'
'Necessite d'activer la reference Microsoft Outlook xx.x Object Library
'
Dim outApp As Outlook.Application
Dim oItem As Outlook.MailItem
Dim leSujet As String, leDestinataire As String
Dim i As Integer


Set outApp = CreateObject("Outlook.Application")

leSujet = "Essai de publipostage VBA avec pieces jointes"


'Afficher le 1er enregistrement du publipostage
ActiveDocument.MailMerge.DataSource.ActiveRecord = wdFirstRecord


'boucle sur tous les enregistrements de la base de données
For i = 1 To ActiveDocument.MailMerge.DataSource.RecordCount
'récupération des adresses mail qui sont dans le champ "champMail"
leDestinataire = ThisDocument.MailMerge.DataSource.DataFields("Email").Value


Set oItem = outApp.CreateItem(olMailItem)
'Application.DisplayAlerts = wdAlertsNone


With oItem
.Subject = leSujet
.Body = ThisDocument.Content 'insère le contenu du document dans le corps du message
.To = leDestinataire
'ajout d'un fichier attaché
.Attachments.Add "C:\Coucou.txt"
.Send 'envoi du mail
End With


'pour passer à l'enregistrement suivant
ThisDocument.MailMerge.DataSource.ActiveRecord = wdNextRecord
Set oItem = Nothing
Next i


Set outApp = Nothing
End Sub
 

Fred 33

XLDnaute Nouveau
Re : Publipostage Excel/Word avec pièce jointe

J'ai trouvé une solution à mon problème.
Je la publie ici, cela pourra peut-être aider quelqu'un.

Pour faire du publipostage avec une pièce jointe entre Word et Outlook avec une base de données sous Excel. Au lancement d'un document Word (établi à l'avance avec les champs de fusion) depuis Excel, une commande dans Word ,ce pourrait être dans Excel, lance Outlook. Je signe les macros afin de garder la protection des macro à "moyen ou élevé".
Depuis un nouveau bouton de barre d'outil Word je lance la boite de dialogue fichiers et je sélectionne le fichier, puis je colle le chemin dans le presse papier. Une macro sous Outlook, récupère le presse papier, le colle dans une variable., la macro vérifie que le dossier est présent et le rajoute en pièce jointe au document courant. Pour que cela fonctionne il suffit de fusionner vers un document électronique avec le bouton de la barre d'outil "Fusion et Publipostage" et le tour est joué sans activer la protection d'Outlook.
C'est certes du bricolage mais, cela fonctionne parfaitement.


Dans Outlook

Macro à placer dans ThisOutlookSession

Activer la Référence Microsoft Forms 2.0 Object Library
Au besoin la référencer par Parcourir Windows\System32\FM20.DLL

Option Explicit

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
'By Fred 33 le 21/05/2008
Dim objCurrentMessage As MailItem
Dim sNomFichier As String
Dim var2 As String
With New DataObject
.GetFromClipboard
var2 = .GetText(1) 'Récupère le chemin copier dans le presse papier
End With

Set objCurrentMessage = Item

sNomFichier = var2

If ExistenceFichier(sNomFichier) Then objCurrentMessage.Attachments.Add Source:=var2
End Sub

Function ExistenceFichier(sFichier As String) As Boolean
ExistenceFichier = Dir(sFichier) <> "" 'Valide l'existence du fichier
End Function

Dans Word
Activer la Référence Microsoft Forms 2.0 Object Library

A placer dans ThisDocument
Private Sub Document_Open()
Shell "OUTLOOK.EXE", 3 'Ouvre Outloock en arrière plan, à l'ouverture du document Word

ActiveDocument.MailMerge.OpenDataSource Name:= _
"C:\Temp\PubliEmail.xls", ConfirmConversions:=False, ReadOnly:= _
False, LinkToSource:=True, AddToRecentFiles:=False, PasswordDocument:="", _
PasswordTemplate:="", WritePasswordDocument:="", WritePasswordTemplate:= _
"", Revert:=False, Format:=wdOpenFormatAuto, Connection:= _
"Provider=Microsoft.Jet.OLEDB.4.0;Password="""";User ID=Admin;Data Source=C:\Temp\PubliEmail.xls;Mode=Read;Extended Properties=""HDR=YES;IMEX=1;"";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Database Password="""";Jet OLEDB:Engine" _
, SQLStatement:="SELECT * FROM `Email$`", SQLStatement1:="", SubType:= _
wdMergeSubTypeAccess
Application.Activate

En sub
C:\Temp\PubliEmail.xls 'Dossier qui contient la base de données de fusion sous Excel
Email ' Colonne Excel qui contient les adresses Email

Macro à placer dans ThisDocument ou dans un module, puis ajouter un bouton dans la barre d'outil Publipostage (Par exemple)
Par Ajouter/Supprimer des boutons Personnaliser / Commande / Macro / Enregistrer dans : Le document qui contient la macro ou dans Normal.Dot si vous avez choisi d'y mettre la macro (Pas recommandé)

Sub Ajouter_Pièce_Jointe()
Dim Var1 As String
Dim Var2 As String

'Declare a variable as a FileDialog object.
Dim fd As FileDialog

'Create a FileDialog object as a File Picker dialog box.
Set fd = Application.FileDialog(msoFileDialogFilePicker) 'Affiche la boite Fichier de windows

'Declare a variable to contain the path
'of each selected item. Even though the path is a String,
'the variable must be a Variant because For Each...Next
'routines only work with Variants and Objects.
Dim vrtSelectedItem As Variant

'Use a With...End With block to reference the FileDialog object.
With fd
.InitialFileName = "c:\Fred_Evasion"
.AllowMultiSelect = False
.Title = " Sélectionner la pièce à joindre, puis cliquez sur OK"
'Use the Show method to display the File Picker dialog box and return the user's action.
'The user pressed the action button.
If .Show = -1 Then

'Step through each string in the FileDialogSelectedItems collection.
For Each vrtSelectedItem In .SelectedItems

'vrtSelectedItem is a string that contains the path of each selected item.
'You can use any file I/O functions that you want to work with this path.
'This example simply displays the path in a message box.
'MsgBox "Le fichier choisi est: " & vrtSelectedItem
Var1= vrtSelectedItem
Next vrtSelectedItem
'The user pressed Cancel.
Else
End If
End With

'Set the object variable to nothing.
Set fd = Nothing
Set MyData = New DataObject
MyData.SetText Var1
MyData.PutInClipboard
'MyData.GetFromClipboard
'Var2 = MyData.GetText
'MsgBox Var2, , " Fichier à joindre" 'Si vous voulez afficher une boite avec le fichier sélectionner, enlever l'apostrophe des trois dernières lignes

End Sub
 

Discussions similaires

Réponses
2
Affichages
161
Réponses
2
Affichages
368
Réponses
6
Affichages
381

Statistiques des forums

Discussions
312 836
Messages
2 092 655
Membres
105 479
dernier inscrit
chaussadas.renaud