Microsoft 365 Publipostage automatique de plusieurs fichiers word à partir d'excel

yannlion

XLDnaute Junior
Bonsoir à tous,

Non expert en VBA et grâce en lisant les posts du forum, j'ai réussi seul à automatiser l'enregistrement automatique d'un publipostage dans un dossier variable à l'aide de cette macro dans word :

VB:
Function Exist_Rep(Rep As String) As Boolean
    On Error Resume Next
    Exist_Rep = GetAttr(Rep) And vbDirectory
End Function

Sub TestPublipostage()
'
' TestPublipostage Macro

' Déclaration des variables
Dim objDoc As Document
Dim Dossier As String
Dim Fichiers As String
Dim iR As Integer
Dim i As Integer
Dim oDoc As Document
Dim DocName As String
Dim oDS As MailMergeDataSource
Dim chemincourt As String
Dim cheminlong As String
Dim resultat As String
    
    resultat = InputBox("Coller ici le nom du dossier", "Nom du dossier ?") 'La variable reçoit la valeur entrée dans l'InputBox
    
    If resultat <> "" Then 'Si la valeur est différente de "" on affiche le résultat
        MsgBox resultat
    End If

' Affectation des objets
DocName = CreateObject("Scripting.FileSystemObject").GetBaseName(ActiveDocument.Name)
Set oDoc = ActiveDocument
Set oDS = oDoc.MailMerge.DataSource

iR = oDoc.MailMerge.DataSource.RecordCount
Debug.Print iR
With oDoc.MailMerge
'Définition du premier et dernier enregistrement
With .DataSource
.FirstRecord = wdDefaultFirstRecord
.LastRecord = wdDefaultLastRecord
End With

' Envoi des données dans un nouveau document
.Destination = wdSendToNewDocument

' Exécution du publipostage
.Execute

Debug.Print DocName; i
End With

' Sauvegarde du document publiposté

chemincourt = "C:\Users\yanni\Downloads\FDN NBTA\" & resultat
cheminlong = "C:\Users\yanni\Downloads\FDN NBTA\" & resultat & "\IMPRESSIONS\"
If Not Exist_Rep(chemincourt) Then MkDir chemincourt
If Not Exist_Rep(cheminlong) Then MkDir cheminlong

With ActiveDocument
.ExportAsFixedFormat OutputFileName:= _
cheminlong & DocName & ".pdf" _
, ExportFormat:=wdExportFormatPDF
ActiveDocument.Close SaveChanges:=wdDoNotSaveChanges
End With

Documents.Close SaveChanges:=wdDoNotSaveChanges
Application.Quit SaveChanges:=wdDoNotSaveChanges
End Sub

J'imagine que c'est surement simplifiable mais là n'est pas la question :)

J'ai, dans un dossier dont l'emplacement est C:\Users\yanni\Downloads\FDN NBTA\TRAME FDN, 20 fichiers word du même type avec chacun son publipostage, chacun sa connexion SQL et j'aimerais pouvoir tous les lancer à partir d'un fichier excel ou word.

Est-ce possible ?

J'avoue que cela atteint mes limites ...

Merci le forum
Yann
 

Laurent78

XLDnaute Occasionnel
Bonsoir,
Et pourquoi ne pas faire un batch (fichier .bat) en utilisant les commutateurs /t et /m pour ouvrir les fichiers word et lancer la macro les uns après les autres ?
Je ne suis pas devant mon pc, donc pas pratique pour donner un exemple.
Si vous connaissez les batch, ma réponse devrait vous aider.
Bonsoir à tous,

Non expert en VBA et grâce en lisant les posts du forum, j'ai réussi seul à automatiser l'enregistrement automatique d'un publipostage dans un dossier variable à l'aide de cette macro dans word :

VB:
Function Exist_Rep(Rep As String) As Boolean
    On Error Resume Next
    Exist_Rep = GetAttr(Rep) And vbDirectory
End Function

Sub TestPublipostage()
'
' TestPublipostage Macro

' Déclaration des variables
Dim objDoc As Document
Dim Dossier As String
Dim Fichiers As String
Dim iR As Integer
Dim i As Integer
Dim oDoc As Document
Dim DocName As String
Dim oDS As MailMergeDataSource
Dim chemincourt As String
Dim cheminlong As String
Dim resultat As String
   
    resultat = InputBox("Coller ici le nom du dossier", "Nom du dossier ?") 'La variable reçoit la valeur entrée dans l'InputBox
   
    If resultat <> "" Then 'Si la valeur est différente de "" on affiche le résultat
        MsgBox resultat
    End If

' Affectation des objets
DocName = CreateObject("Scripting.FileSystemObject").GetBaseName(ActiveDocument.Name)
Set oDoc = ActiveDocument
Set oDS = oDoc.MailMerge.DataSource

iR = oDoc.MailMerge.DataSource.RecordCount
Debug.Print iR
With oDoc.MailMerge
'Définition du premier et dernier enregistrement
With .DataSource
.FirstRecord = wdDefaultFirstRecord
.LastRecord = wdDefaultLastRecord
End With

' Envoi des données dans un nouveau document
.Destination = wdSendToNewDocument

' Exécution du publipostage
.Execute

Debug.Print DocName; i
End With

' Sauvegarde du document publiposté

chemincourt = "C:\Users\yanni\Downloads\FDN NBTA\" & resultat
cheminlong = "C:\Users\yanni\Downloads\FDN NBTA\" & resultat & "\IMPRESSIONS\"
If Not Exist_Rep(chemincourt) Then MkDir chemincourt
If Not Exist_Rep(cheminlong) Then MkDir cheminlong

With ActiveDocument
.ExportAsFixedFormat OutputFileName:= _
cheminlong & DocName & ".pdf" _
, ExportFormat:=wdExportFormatPDF
ActiveDocument.Close SaveChanges:=wdDoNotSaveChanges
End With

Documents.Close SaveChanges:=wdDoNotSaveChanges
Application.Quit SaveChanges:=wdDoNotSaveChanges
End Sub

J'imagine que c'est surement simplifiable mais là n'est pas la question :)

J'ai, dans un dossier dont l'emplacement est C:\Users\yanni\Downloads\FDN NBTA\TRAME FDN, 20 fichiers word du même type avec chacun son publipostage, chacun sa connexion SQL et j'aimerais pouvoir tous les lancer à partir d'un fichier excel ou word.

Est-ce possible ?

J'avoue que cela atteint mes limites ...

Merci le forum
Yann

Bonne soirée,
Laurent
 

yannlion

XLDnaute Junior
Un début de batch mais qui ne fonctionne pas :)

VB:
Option Explicit
On Error Resume Next
MacroWord
 
Sub MacroWord()
 
  Dim ApplicationWord
  Dim ClasseurWord
 
  Set ApplicationWord = CreateObject("Word.Application")
 
  'ouverture du premier classeur + lancement d'une macro
  Set ClasseurWord = ApplicationWord.Document.Open("C:\Users\yanni\Downloads\FDN NBTA\TRAME FDN\01A Feuille de note Solo 1  baton - Poussin Préliminaire.docx")
  ApplicationWord.Visible = True 
  ApplicationWord.Run "creerfdn"
  DocumentWord.Close 'fermeture du premier classeur
 
  'ouverture de deuxième classeur
  Set ClasseurWord = ApplicationWord.Document.Open("C:\Users\yanni\Downloads\FDN NBTA\TRAME FDN\06 Feuille de note Duo Débutant.docx")
  ApplicationWord.Visible = True 
  ApplicationWord.Run "creerfdn"
 
  'fermeture de Word
  ApplicationWord.Quit
 
  Set ClasseurWord = Nothing
  Set ApplicationWord = Nothing
 
End Sub
 

Discussions similaires

Statistiques des forums

Discussions
314 708
Messages
2 112 090
Membres
111 416
dernier inscrit
philipperoy83