envoi mail avec pièce jointe

rihem ben rhaiem

XLDnaute Nouveau
Bonjour,
je travaille en tant qu'une financière et je suis censée d'envoyer à chaque fournisseurs son certificat de retenue à la source sous format PDF.
j'ai créée un publipostage Word avec une base de donnée Excel pour faire l'envoi via Outlook afin de faire les retenues une à une et les enregistrer sous format PDF avec le MAIL du fournisseur.
le tout marche très bien mais j'ai un problème au niveau de l'envoi via Outlook, il envoi des MAILS sans fichiers PDF.
veuillez trouver ci-dessous les macros que j'ai utilisé, mais je pense qu'il s'agit d'un problème de paramétrage Outlook, en fin je crois je ne sais pas.
veuillez trouver ci-joint un exemple de fichier PDF nommé par MAIL.

le 1er est pour établir les certificat en les découpant PDF.

Attribute VB_Name = "Module1"
Attribute VB_Name = "Découpe_PDF"

'Découpage Publipostage en PDF
Sub Decoupe_PDF()
' Désactiver le rafraichissement d'écran pour accélérer la procédure
Application.ScreenUpdating = False

' Déclaration des variables
Dim iR As Integer
Dim i As Integer
Dim oDoc As Document
Dim DocName As String
Dim oDS As MailMergeDataSource

' Affectation des objets
Set oDoc = ActiveDocument
Set oDS = oDoc.MailMerge.DataSource

iR = oDoc.MailMerge.DataSource.RecordCount
Debug.Print iR
For i = 1 To iR
With oDoc.MailMerge
'Définition du premier et dernier enregistrement
.DataSource.FirstRecord = i

.DataSource.LastRecord = i
' Envoi des données dans un nouveau document
.Destination = wdSendToNewDocument
' Exécution du publipostage
.Execute
' Actualisation de l'enregistrement pour la sauvegarde
.DataSource.ActiveRecord = i
'-------------------------Indiquer ci-dessous dans les parenthèses le n° du champ (de concaténation) pour nommer le document-----------------------
DocName = .DataSource.DataFields(1).Value
Debug.Print DocName; i
End With
'-------------------------Sauvegarde du document publiposté : Précisez le chemin de votre dossier ou seront enregistrées les pièces jointes en pdf-------------
With ActiveDocument
.ExportAsFixedFormat OutputFileName:= _
"C:\Users\Patricia\Desktop\PJ\" & DocName & ".pdf", ExportFormat:=wdExportFormatPDF, _
OpenAfterExport:=False, OptimizeFor:=wdExportOptimizeForPrint, Range:= _
wdExportAllDocument, From:=1, To:=1, Item:=wdExportDocumentContent, _
IncludeDocProps:=True, KeepIRM:=True, CreateBookmarks:= _
wdExportCreateNoBookmarks, DocStructureTags:=True, BitmapMissingFonts:= _
True, UseISO19005_1:=False
.Close SaveChanges:=wdDoNotSaveChanges
End With
Next i
End Sub


le 2eme:
Attribute VB_Name = "Publiidem"
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 & "PUBLIIDEM" & vbCr & "dans le sujet." & vbCr & "Celui-ci sera retiré lors de l'envoi"

End Sub


le 3eme:
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\Patricia\Desktop\PJ\")

'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
 

Discussions similaires

Réponses
3
Affichages
255

Statistiques des forums

Discussions
298 812
Messages
1 971 980
Membres
203 575
dernier inscrit
Melvin Thouvenel