Bonjour,

J'ai adapté le code d'aaronc que m'avait donné hyperion, que je remercie vivement.

J'ai donc les fichiers Visuel FOURNISSEUR.pdf qui sont bien générés avec les 3 fichiers file1, file2 et file3 pour tous les fournisseurs de ma table.
En revanche, tous ces fournisseurs n'ont pas les mêmes visuels et ces derniers sont mentionnés dans un champ [N° PAGE] de ma table [T_Import PUB]

Pourriez-vous m'aider à retravailler mon code (ci-dessous) pour que puisse générer mon fichier uniquement avec les visuels qui concernent chaque fournisseur ?
J'ai fait plusieurs essais hélas sans résultat probant.

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
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
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
 
Option Compare Database
 
 
Sub GenPDF()
'https://forums.pdfforge.org/t/any-idea-if-the-vba-bug-works-every-second-time-will-be-adressed/15668/4
On Error GoTo MyErrorHandler
 
    Dim RS As DAO.Recordset
    Dim sRep As String
    Dim fullPath
    Dim PDFCreatorQueue As Variant
    Dim printJob As Variant
    Dim oPDF As Variant
    Dim i As Integer
 
    Set RS = CurrentDb.OpenRecordset("select distinct FOURNISSEUR, [N° PAGE] from [T_Import PUB]")
    sRep = "d:\Access\Test\Envoi facture par mail\Officiel\"
 
    Set PDFCreatorQueue = CreateObject("PDFCreator.JobQueue")
    Set oPDF = CreateObject("PDFCreator.PdfCreatorObj")  'PDFCreator.clsPDFCreator
 
    file1 = "D:\Access\Test\Envoi facture par mail\Officiel\9.pdf"
    file2 = "D:\Access\Test\Envoi facture par mail\Officiel\11.pdf"
    file3 = "D:\Access\Test\Envoi facture par mail\Officiel\14.pdf"
 
 
 Do Until RS.EOF = True
 
 
 
    fullPath = sRep & "Visuel " & RS.Fields("FOURNISSEUR") & ".pdf"
'    MsgBox "Initializing PDFCreator queue..."
 
'    MsgBox "Sending the files to the queue. This can take a minute.."
 
    PDFCreatorQueue.Initialize
 
    DoCmd.Hourglass True  ' turn on Hourglass
TOP:
    oPDF.AddFileToQueue file1
    oPDF.AddFileToQueue file2
    oPDF.AddFileToQueue file3
 
    If Not PDFCreatorQueue.WaitForJobs(3, 15) Then
        If i < 6 Then
            PDFCreatorQueue.Clear
            i = i + 1
            GoTo TOP
        End If
    Else
        DoCmd.Hourglass False ' turn off hourglass
'        MsgBox "There are now " & PDFCreatorQueue.Count & " file(s) in the queue to be merged."
 
        PDFCreatorQueue.MergeAllJobs
        Set printJob = PDFCreatorQueue.NextJob
        printJob.SetProfileByGuid ("DefaultGuid")
 
'        MsgBox "PDFCreator will now create the merged file. This can take a few minutes for large files."
        DoCmd.Hourglass True  ' turn on Hourglass
        printJob.ConvertTo (fullPath)
        DoCmd.Hourglass False ' turn off hourglass
 
        If (Not printJob.IsFinished Or Not printJob.IsSuccessful) Then
'            MsgBox "Creation failed: Could not merge files or file count was not 3."
        Else
 '           MsgBox "Creation finished successfully"
        End If
    End If
 
    PDFCreatorQueue.ReleaseCom
 
 
    RS.MoveNext
    Loop
 
    ' Terminé
    RS.Close
    Set RS = Nothing
    MsgBox "Opération terminée !", vbInformation
 
 
    Exit Sub
 
MyErrorHandler:
    PDFCreatorQueue.ReleaseCom
    Dim Msg As String
    Msg = "Error No " & Err.Number & ": " & Err.Description
 
    If Err.Number = -2146233079 Then
        MsgBox Msg + " Please clear the queue, turn off PDFCreator and try again."
    Else
        MsgBox Msg
    End If
End Sub