Microsoft 365 fusion de document vba publipostage

Sub Envoimail3()
Dim sfichier As String
Dim omsgapp As Outlook.Application
Dim omsg As Outlook.MailItem
Dim ligne As Integer
For ligne = 2 To Cells(Rows.Count, 1).End(xlUp).Row
Set omsgapp = New Outlook.Application
Set omsg = omsgapp.CreateItem(olMailItem)
With omsg
.To = Range("am" & ligne)
.Attachments.Add Range("an" & ligne)
.Subject = " organisation Customer service EXPORT "
.Body = " Bonjour," & Chr(10) & Chr(10) & "Nous avons le plaisir de vous presenter la nouvelle organisation du customer service , nous vous laissons la découvrir à la lecture de la pièce jointe." & Chr(10) & Chr(10) & "Le service client reste à votre disposition et vous souhaite une bonne journée." & Chr(10) & Chr(10) & "Le service client."
.Send
End With
Next
End Sub

Sub Export_Publipost_PDF_single()
Dim rep_PDF$, i&
'affichage boite dialogue pour choix dossier Export
'par défaut pointe sur le dossier du document Word contenant ce code VBA
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Choisir le dossier d'export PDF"
.InitialFileName = ActiveDocument.Path & "\"
If .Show Then rep_PDF = .SelectedItems(1) Else Exit Sub
End With
Application.ScreenUpdating = False
'-> la macro lance le publipostage
For i = 1 To ActiveDocument.MailMerge.DataSource.RecordCount
With ActiveDocument.MailMerge
.Destination = wdSendToNewDocument
.SuppressBlankLines = True
With .DataSource
.FirstRecord = i
.LastRecord = i
.ActiveRecord = i
docname = .DataFields("NOM").Value & ".pdf"
'création du nom du fichier PDF basé sur le champ de fusion NOM
'-> adapter selon vos besoins, en remplaçant NOM par le champ idoine
End With
.Execute Pause:=False
End With
'->export en PDF unique pour chaque enregistrement dans la base
ActiveDocument.ExportAsFixedFormat OutputFileName:=rep_PDF & "\" & docname, _
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
ActiveWindow.Close False
Next i
End Sub