Publipostage individuel PDF - Problème VBA

**LouRiche** · 16/11/2020, 17h17

Bonjour à tous,

Je suis confrontée à un problème que je n'ai pas résolu en parcourant les différentes discussion sur le sujet.
Je tente d'automatiser la génération en PDF d'avenants de contrat (individuels) via une base de donnée excel (500 personnes) et un word en publipostage.
J'ai utiliser la programmation VBA ci dessous (je suis débutante). J'ai alors un message d'erreur 3651"Impossible de fusionner ... enregistrements tous vides ou aucun enregistrement de répondait à vos options de requête" avec un stop sur .Execute.

Je suis bloquée et j'ai vérifié mes champs excel/word, ma selection de destinataires, les apperçus et la manip à la main fonctionnent. Est ce que quelqu'un aurait une piste?

Merci pour votre aide

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
Sub TestPDF()
'Déclaration variables
Dim iR As Integer
Dim i As Integer
Dim oDoc As Document
Dim docName As String
Dim oDS As MailMergeDataSource
 
'Affectation des objets
Set oDoc = ActiveDocument
Set oDS = oDoc.MailMerge.DataSource
 
iR = oDoc.MailMerge.DataSource.RecordCount
Debug.Print iR
For i = 1 To iR
    With oDoc.MailMerge
        'Premier & dernier enregistrement
        .DataSource.FirstRecord = i
        .DataSource.LastRecord = i
        'Envoi dans un nouveau doc
        .Destination = wdSendToNewDocument
        .Execute
        'Actualisation de l'enregistrement pour la sauvegarde
        .DataSource.ActiveRecord = i
        docName = .DataSource.DataFields(7).Value
        docName = docName & .DataSource.DataFields(8) & "Avenant télétravail"
        Debug.Print docName; i
    End With
    With ActiveDocument
        .SaveAs "C:\Users\MONID\BOITE\SERVICE (Grp. O365) - Documents\Télétravail\Avenants pour envoi\" & docName & ".pdf", wdExportFormatPDF
        .Close
    End With
Next i

Invité · 16/11/2020, 17h48

Envoyé par LouRiche

Bonjour,

Essayez ce code, pas testé :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
 
Sub TestPDF()
 
'Déclaration variables
Dim IR As Integer, I As Integer
Dim DocName As String, RepertoireDestination As String
Dim oDoc As Document
Dim oDS As MailMergeDataSource
 
    RepertoireDestination = "C:\Users\MONID\BOITE\SERVICE (Grp. O365) - Documents\Télétravail\Avenants pour envoi\"
 
    'Affectation des objets
    Set oDoc = ActiveDocument
    Set oDS = oDoc.MailMerge.DataSource
 
    IR = oDoc.MailMerge.DataSource.RecordCount
    ' Debug.Print IR
 
    For I = 1 To IR
 
        With oDoc.MailMerge
 
                'Premier & dernier enregistrement
                .DataSource.FirstRecord = I
                .DataSource.LastRecord = I
 
                'Envoi dans un nouveau doc
                .Destination = wdSendToNewDocument
                .Execute
 
                'Actualisation de l'enregistrement pour la sauvegarde
                With .DataSource
                     .ActiveRecord = I
                     DocName = .DataFields(7) & .DataFields(8) & "Avenant télétravail"
                     Debug.Print DocName; I
                End With
 
                With ActiveDocument
                   .ExportAsFixedFormat OutputFileName:= _
                   RepertoireDestination & DocName & ".pdf", 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
                   .Close savechanges:=wdDoNotSaveChanges
                End With
 
        End With
 
 
    Next I
 
 
    Set oDoc = Nothing
    Set oDS = Nothing
 
End Sub

**LouRiche** · 16/11/2020, 17h59

Bonjour Eric,
Malheureusement cela m'affiche le même message d'erreur

Invité · 16/11/2020, 18h02

Envoyé par LouRiche

Ce code fonctionne, il faudrait vérifier votre base de données. Si vous en avez la possibilité mettez un exemple non confidentiel en ligne dans un fichier .zip.

**LouRiche** · 16/11/2020, 18h27

Envoyé par Eric KERGRESSE

Ce code fonctionne, il faudrait vérifier votre base de données. Si vous en avez la possibilité mettez un exemple non confidentiel en ligne dans un fichier .zip.

Télétravail.7z

Il me semblait bien que le code n'était pas le problème ... mais je ne vois pas le problème ailleurs non plus.

J'ai fait une version non confidentielle (qui ne fonctionne pas non plus chez moi).
Après, parmi mes hypothèses: je suis sur windows 2010 et mes documents sont sur un dossier synchronisé onedrive/sharepoint. Est ce que cela pourrait jouer?

Merci beaucoup

Invité · 16/11/2020, 18h35

Envoyé par LouRiche

Je n'arrive pas à ouvrir votre fichier. Dans l'explorateur Windows, clic droit sur le fichier et Envoyer sur dossier compressé.

**LouRiche** · 16/11/2020, 18h51

Envoyé par Eric KERGRESSE

Je n'arrive pas à ouvrir votre fichier. Dans l'explorateur Windows, clic droit sur le fichier et Envoyer sur dossier compressé.

TestAvenantNC.zip
C'est bon ?

Invité · 16/11/2020, 19h50

Envoyé par LouRiche

J'ai supprimé le data source du fichier word, j'ai dupliqué la base de donnée et j'ai rendu plus clairs les civilités, noms, prénoms.

Dans le code, il vous faut prendre les champs 6 et 7 au lieu des 7 et 8. Vous trouverez les résultats dans le zip. J'ai le même message que vous avec la base d'origine. Le publipostage à bien fonctionné avec le deuxième fichier.

**LouRiche** · 17/11/2020, 12h03

Bonjour Eric,

Merci beaucoup pour ce retour. Après avoir épluché les cas ou cela fonctionne et les autres, je me rends compte qu'une variable fait planter l'action : si les destinataires sélectionnés ne sont pas à la suite et au début de l'excel alors cela ne fonctionne pas.
Ex : les lignes 1,2 et 3 sélectionnées => fonctionne
1,4 et 6 sélectionné => seulement la ligne 1 est enregistrée en PDF
3,4 et 5 => Aucune ne sort : tout de suite message d'erreur.

Est ce qu'il y a quelque chose à faire côté code ou je dois forcément recopier les lignes que je veux feuille 2 pour ne pas avoir à sélectionner les destinataires ?

J'ai trouvé une solution : ne pas sélectionner dans Excel les destinataire mais les filtrer à partir d'une colonne, alors tout fonctionne. MERCI BEAUCOUP ERIC !

Merci à vous

Invité · 17/11/2020, 12h17

Envoyé par LouRiche

Après de nombreux essais...

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
 
Sub PublipostageAvecSelectionPartielle()
 
Dim DernierEnregistrement As Integer
Dim DocName As String, RepertoireDestination As String
Dim oDoc As Document
 
 
    Set oDoc = ActiveDocument
    RepertoireDestination = "D:\Documents\VBA Word\Publipostage\Publipostage 2020-11-16\Repertoire pdf\"  ' Adapter
 
    With oDoc.MailMerge.DataSource
 
         .ActiveRecord = wdLastRecord
         DernierEnregistrement = .ActiveRecord
         .ActiveRecord = wdFirstRecord
 
         Do While .ActiveRecord <> wdLastRecord
 
            .FirstRecord = .ActiveRecord
            .LastRecord = .ActiveRecord
 
            'Debug.Print .ActiveRecord
 
            'Envoi dans un nouveau doc
            With oDoc.MailMerge
                 .Destination = wdSendToNewDocument
                 .Execute
            End With
 
            ' Recherche des nom et prénom dans l'enregistrement pour la sauvegarde
            DocName = .DataFields(6) & .DataFields(7) & "Avenant télétravail"
 
            With ActiveDocument
                   .ExportAsFixedFormat OutputFileName:= _
                   RepertoireDestination & DocName & ".pdf", 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
                   .Close savechanges:=wdDoNotSaveChanges
             End With
 
             If .ActiveRecord = DernierEnregistrement Then Exit Do
 
             .ActiveRecord = wdNextRecord
 
        Loop
 
    End With
 
    Set oDoc = Nothing
 
    MsgBox "Fin du publipostage !", vbInformation
 
End Sub

Regardez si cela fonctionne chez vous. Cela permettra de valider le code pour ceux qui en auraient besoin.