Word Publipostage - VBA - Enregistrer un document word en PDF sous un nouveau nom

[Susuwatari]

Bonjour,

Je débute depuis peu sur VBA et souhaite automatiser un envoi de mail à partir d'une base de données Excel (Commune, Département ...).

J'ai créer un formulaire Excel qui me permet d'ouvrir un document Word en publipostage. Le document Word se complète en fonction de la base de donnée.
Maintenant j'aimerais créer une macro me permettant d'enregistrer sous un format PDF le document Word qui se trouve sous mes yeux. J'aimerais par la même occasion modifier son nom par "Demande d'arrêté - "Commune en question".

Aujourd'hui mon problème est que le nom du PDF prend le nom de la commune du destinataire précédant.
Exemple :
Publipostage N°3 --> Paris
Publipostage N°4 --> Lyon
J'active ma macro en ayant le Word de Lyon sous les yeux, il s'enregistre sous format PDF cependant le nom du fichier est "Demande d'arrêté - Paris".

Voici le VBA en question :

Sub Word_to_PDF()

Dim chemin As String, nom As String
chemin = "C:\Users\dossier\"

With ActiveDocument.MailMerge
.Destination = wdSendToNewDocument
.SuppressBlankLines = True

With .DataSource
.FirstRecord = ActiveDocument.MailMerge.DataSource.ActiveRecord
.LastRecord = ActiveDocument.MailMerge.DataSource.ActiveRecord
End With

.Execute Pause:=False
nom = .DataSource.DataFields("Commune")
End With

ActiveDocument.ExportAsFixedFormat OutputFileName:= chemin & "Demande d'arrêté - " & nom & ".pdf" _
, ExportFormat:=wdExportFormatPDF, openafterexport:=True, OptimizeFor:= _
wdExportOptimizeForPrint, Range:=wdExportAllDocument, From:=1, To:=1, _
Item:=wdExportDocumentContent, IncludeDocProps:=True, KeepIRM:=True, _
CreateBookmarks:=wdExportCreateNoBookmarks, DocStructureTags:=True, _
BitmapMissingFonts:=True, UseISO19005_1:=False
End Sub

Avez vous une solution pour palier à ce problème ?
J'ai pensé a une décrémentation pour faire prendre la valeur du "Commune" du publipostage précédent mais je ne sais absolument pas comment faire ce genre de chose...

PS : lorsque je fais une recherche de destinataire pour trouver le publipostage de la commune qui m’intéresse, la recherche me place systématiquement sur le publipostage suivant. Exemple : Je cherche Paris (Publipostage N°3) et je tombe sur Lyon (Publipostage N°4).

PSPS : J'ai du ajouter une ligne vierge dans ma base de données car sinon les informations de ma première commune n'apparaissent pas en publipostage.

PSPSPS : J'ai constamment un publipostage vierge en dernière position.

Je vous indique ces précisions car je pensais que le problème de décalage de commune lors de l'enregistrement était lié au problème de décalage lors de la recherche de destinataire. Cependant je n'ai rien trouvé à ce propos sur internet...

J'espère avoir été assez clair dans mes explications et vous remercie d'avance pour votre aide,

Susuwatari

 

[kiki29]

Salut, à lire et pas seulement : Le publipostage Word-Excel

 

[Susuwatari]

Bonjour kiki29,

Je te remercie pour ton lien. Il explique bien les bases du publipostage cependant j'attend un une explication un peu plus poussée...

Toujours en attente d'une solution,

Cdlt

 

[jui42]

Bonjour,
Voici un code VBA permettant de convertir tous les fichiers Word contenu dans un dossier en fichier PDF.

Option Explicit

Sub PDF_Word()
Dim chemin$, doc$, Wapp As Object, pdf$
chemin = ThisWorkbook.Path & "\" 'à adapter
doc = Dir(chemin & "*.docx") '1er document du dossier
Application.DisplayAlerts = False 'si un document Word est ouvert
On Error Resume Next
Set Wapp = GetObject(, "Word.Application")
If Wapp Is Nothing Then Set Wapp = CreateObject("Word.Application")
While doc <> ""
    pdf = Left(doc, InStrRev(doc, ".") - 1) & ".pdf"
    With Wapp.Documents.Open(chemin & doc)
        .ExportAsFixedFormat chemin & pdf, ExportFormat:=17 '17 => wdExportFormatPDF
        .Close False
    End With
    doc = Dir 'document suivant du dossier
Wend
If Wapp.Documents.Count = 0 Then Wapp.Quit
End Sub

Cordialement,

 

[jui42]

PS : A placer dans un doc Excel
Voici le script sous Word ;

Sub Main()
    
    Dim Source_Folder_Path As String, Target_Folder_Path As String
    Dim File_Names As String
    Dim doc As Document
    
    '// Step 1. Assign Folder Paths
    Source_Folder_Path = "votre chemin ou se trouve les pdf"
    Target_Folder_Path = "votre chemin ou vous voulez que les word se crée"
    
    If Right(Source_Folder_Path, 1) <> "\" Then
        Source_Folder_Path = Source_Folder_Path & "\"
    End If
    
    If Right(Target_Folder_Path, 1) <> "\" Then
        Target_Folder_Path = Target_Folder_Path & "\"
    End If
    
    '// Step 2. Grad all the PDF files
    
    File_Names = Dir(Source_Folder_Path & "*.pdf")
    
    Application.DisplayAlerts = wdAlertsNone
    
    Do While File_Names <> ""
        
        Set doc = Documents.Open(Source_Folder_Path & File_Names, False)
        
        '// Convert the PDF file to Word Doc
        doc.SaveAs2 Target_Folder_Path & Replace(File_Names, ".pdf", ".docx"), wdFormatDocumentDefault
        doc.Close False
        
        Set doc = Nothing
        
        File_Names = Dir()
    Loop
    
    Application.DisplayAlerts = wdAlertsAll
    
    MsgBox "Conversion is finished"
End Sub

cdt