Emailing avec PJ personnalisée

Bonjour le forum,

J'ai récupéré sur le net un moyen d'envoyer via outlook une pièce jointe identique via une macro. Elle propose également la méthode pour une pj personnalisée. La PJ reprend le nom et le prénom du mail puis ajoute l'extension PDF par exemple. C'est idéal dans un intranet ou la nomenclature des mails est identique mais ce n'est pas possible quand les mails sont de serveurs différents (free, laposte, numéricable, ...)

Comment paramétrer dans la macro suivante la récupération du nom et du prénom qui se trouve dans ma base de données afin de construire un fichier nommé in finé nom prénom contrat 2016.pdf ?

Merci d'avance pour vos éventuelles contributions...

Voici la macro : (la partie PJ identique de cette macro ne m'intéresse pas mais j'ai laissé la macro complète volontairement)

Pour ThisOutlooksession

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)

'by oliv 05/02/2007 - Corrigée par Patricia et Pascale le 15/04/2013'

'Pour publipostage avec PJ OUTLOOK IDENTIQUE POUR TOUS LES MAILS ou INDIVIDUELLE PAR DESTINATAIRE

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

'Pascale : chemin complet et extension pièce (le fichier doit être nommé avec l'adresse mail du destinataire)

docperso = "C:\Users\Patricia\Desktop\PJ\" & objCurrentMessage.To & ".pdf"

objCurrentMessage.Attachments.Add Source:=docperso

'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

Pour le 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