Mise à jour automatique d'image sur publipostage

Bonjour,

Je reviens vers vous pour une question qui me préoccupe sur mon projet. En fait je dois faire un publipostage qui doit récupérer des images dans la base de données Excel. En le faisant manuellement ça fonctionne et les images changent une à une.

Mais l'idée de départ était de pouvoir mettre à jour toutes les images si je lance l'envoi de mail. Le problème c'est que j'ai une seule image sur toute les mails

J'ai une suggestion pour utilisant du VBA mais je sais pas comment l'utiliser:

Sub FusionEtMiseAjour()
    With ActiveDocument.MailMerge
        .Destination = wdSendToNewDocument
        .SuppressBlankLines = True
        With .DataSource
            .FirstRecord = wdDefaultFirstRecord
            .LastRecord = wdDefaultLastRecord
        End With
        .Execute Pause:=False
    End With
    DoEvents
    Selection.WholeStory 'sélectionne tout le texte de la lettre type
    Selection.Fields.Update 'Met les champs à jour (affiche les images)
End sub

Je vous mets mon code ci-dessous

Sub FusionEnregSuiv()

' FusionEnregSuiv Macro

'
    ActiveDocument.MailMerge.DataSource.ActiveRecord = wdNextRecord

' FusionEnregPrem Macro

    ActiveDocument.MailMerge.DataSource.ActiveRecord = wdFirstRecord

' FusionDernEnreg Macro

    ActiveDocument.MailMerge.DataSource.ActiveRecord = wdLastRecord

' FusionEnregPréc Macro

    ActiveDocument.MailMerge.DataSource.ActiveRecord = wdPreviousRecord
DoEvents
    Selection.WholeStory 'sélectionne tout le texte de la lettre type
    Selection.Fields.Update 'Met les champs à jour (affiche les images)
'
Dim fusion As MailMerge
Dim x As Integer, nb As Integer
Dim chemin As String, nom As String, titre As String, espace As String
titre = "BSI"
espace = " "
Set fusion = ActiveDocument.MailMerge
chemin = "C:\Users\bc00T349\\Desktop\PDF\"  'mettre ici le chemin complet du dossier où stocker les fichiers sans oublier le \ à la fin
nb = fusion.DataSource.RecordCount
For x = 0 To nb - 1
With fusion
    .DataSource.FirstRecord = x + 1
    .DataSource.LastRecord = x + 1
    .Destination = wdSendToNewDocument
    .DataSource.ActiveRecord = x + 1
    nom = .DataSource.DataFields("nom") 'Remplacer nom par le champ à utiliser
    .Execute
End With
'ActiveDocument.ExportAsFixedFormat OutputFileName:=chemin & titre & espace & nom & ".pdf", ExportFormat:=wdExportFormatPDF, openafterexport:=False
ActiveDocument.ExportAsFixedFormat OutputFileName:=chemin & nom & ".pdf", ExportFormat:=wdExportFormatPDF, openafterexport:=False
ActiveDocument.Close savechanges:=False

Next

' Nécessite la référence : Microsoft Outlook 1x Object Library
Dim outApp As Outlook.Application
Dim oItem As Outlook.MailItem
Dim leSujet As String, leDestinataire As String, pieceJointe As String
Dim i As Integer
Dim cell As Range

Set outApp = CreateObject("Outlook.Application")

leSujet = "Bilan Social Individuel (BSI) 2020"

'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
nom = ThisDocument.MailMerge.DataSource.DataFields("nom")
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
.Body = "Bonjour " & nom _
                      & vbNewLine & vbNewLine & _
                        "Veuillez trouvez ci-joint, votre Bilan Social Individuel 2020. " & _
                    vbNewLine & vbNewLine & _
                        "Bonne réception. Cordialement!."
.To = leDestinataire
'ajout d'un fichier attaché

.Attachments.Add ("C:\Users\bc00T349\Desktop\PDF\" & nom & ".pdf")
.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

Votre aide serait appréciée!

Merci d'avance