Fusion pdf avec noms de fichiers variables

**alea83** · 20/02/2024, 16h59

Bonjour à tous,

Je me permet de venir vers vous car je suis coincée avec ce code qui me permet de fusionner des pdf avec PDFCrator.
Le code fonctionne bien avec la recherche des fichiers dans un répertoire, le souci est que les noms des pdf ne sont pas connus (un H dans le nom du premier pdf et Amiante dans le second.
J'ai essayé avec Dir mais cela ne fonctionne pas.
Ci-dessous mon code :
Merci d'avance 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
Dim CtrI As Long
Dim oPDF As PdfCreatorObj
Dim Q As PDFCreator_COM.JobQueue
Dim job As PDFCreator_COM.printJob
Dim CheminFichierFusionne As String, NomFichierFusionne As String, RepertoirePdf As String, ChaineATrouver As String
Dim fso As Object, Fich As Object
 Dim x As String
 
  '  On Error GoTo Fin
 
Pg1 = CurrentProject.Path & "\" & Me.Annee & "\" & Me.NOAffaire & "\Rapport" & Me.NOAffaire & ".pdf"
Pg2 = Dir(CurrentProject.Path & "\" & Me.Annee & "\" & Me.NOAffaire & "\*HAP*.pdf")
Pg3 = Dir(CurrentProject.Path & "\" & Me.Annee & "\" & Me.NOAffaire & "\" & "*" & "Rapport Amiante" & "*" & ".pdf")
 
 
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set oPDF = New PdfCreatorObj
 
   With oPDF
    .AddFileToQueue Pg1
    .AddFileToQueue Pg2
    .AddFileToQueue Pg3
 
    Set Q = New PDFCreator_COM.JobQueue
 
   With Q
        .Initialize
        ' .WaitForJobs 2, 10
         Debug.Print "q.Count: " & Q.Count
         .MergeAllJobs
    End With
 
    While Q.Count > 0
            Set job = Q.NextJob
            job.SetProfileByGuid ("DefaultGuid")
           job.ConvertTo (NomFichierFusionne) '(OutPath)
    Wend
 
    Q.ReleaseCom
 
    MsgBox "Le rapport final est prêt !", vbInformation
 
    GoTo Fin
 
Fin:
 
    Set fso = Nothing
    Set job = Nothing
    Set Q = Nothing
    Set oPDF = Nothing
 
End Sub

**alea83** · 27/02/2024, 09h17

Bonjour à tous,

aucune réponse, personne n'aurai une idée pour solutionner ce problème car cela fonctionne dans un dossier à part qu'il met les pdf dans l'ordre alphabétique ce qui ne peut pas convenir, raison pour laquelle je voulais identifier chaque fichier...

Si quelqu'un peut me venir en aide.
Merci d'avance.

**alea83** · 28/02/2024, 10h19

BOnjour à tous,

J'ai continué mes recherches, et ca marche enfin....
POur ceux que ca interesse...

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
Private Sub Fusion2_Click()
Dim file1 As String
Dim file2 As String
Dim File3 As String
 
file1 = CurrentProject.Path & "\" & Me.Annee & "\" & Me.NOAffaire & "\Rapport" & Me.NOAffaire & ".pdf"
file2 = Me.pdf2
File3 = Me.Pdf3
 
Dim outPath$
outPath = CurrentProject.Path & "\" & Me.Annee & "\" & Me.NOAffaire & "\RapportFinal" & Me.NOAffaire & ".pdf"
 
Dim oPDF As PdfCreatorObj
Set oPDF = New PdfCreatorObj
oPDF.AddFileToQueue file1
oPDF.AddFileToQueue file2
oPDF.AddFileToQueue file3
Debug.Print "oPDF isinstancerunning: " & oPDF.IsInstanceRunning ' close Excel and open if true.
 
On Error GoTo EndSub ' this is commented out for debuging purposes
Dim q As PDFCreator_COM.JobQueue
Set q = New PDFCreator_COM.JobQueue
q.Initialize
q.WaitForJobs 2, 10
 
Debug.Print "q.Count: " & q.Count ' here it prints either 1 or 2. Should always be 2.
 
Dim Ret As Long
If q.Count < 3 And Ret < 6 Then
q.Clear
q.ReleaseCom
Ret = Ret + 1 'count the number of times this action returned without proceeding
'GoTo Top
ElseIf Ret >= 6 Then
MsgBox "The merge PDF return a error."
outPath = CurrentProject.Path & "\" & Me.Annee & "\" & Me.NOAffaire & "ERROR_MERGE.pdf"
End If
 
q.MergeAllJobs
 
Dim job As PDFCreator_COM.printJob
 
While q.Count > 0
        Set job = q.NextJob
        job.SetProfileByGuid ("DefaultGuid")
        job.ConvertTo (outPath)
        Debug.Print job.IsFinished
        Debug.Print job.IsSuccessful
        Debug.Print "q.Count4: " & q.Count
Wend
 
EndSub:
q.ReleaseCom
 
MsgBox "Le rapport est prêt dans le dossier LaboRapport de l'affaire"
End Sub

**alea83** · 05/03/2024, 09h35

Bonjour,

je reviens vers ce post, car le code fonctionne mais si j'ajoute un If Me.pdf3 Is Null (troisième fichier à fusionner) plus rien ne se passe.
J'ai essayé avec Len car le champ contient un chemin d'accés ou rien, mais pareil..

Pouvez vous m'aider ?
Merci d'avance.

**tee_grandbois** · 05/03/2024, 15h43

bonjour,
peut-être faut-il essayer avec

Code :

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

If Me.pdf3 = ""

**alea83** · 06/03/2024, 09h23

BOnjour,

Oui j'ai essayé toutes les possibilités Me.pdf3 = "" then ou Is Null etc.; message : erreur d'exécution 94 utilisation incorrect de Null
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
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
Private Sub Fusion2_Click()
Dim file1 As String
Dim file2 As String
Dim File3 As String
 
Dim outPath$
outPath = CurrentProject.Path & "\" & Me.Annee & "\" & Me.NOAffaire & "\RapportFinal" & Me.NOAffaire & ".pdf"
file1 = CurrentProject.Path & "\" & Me.Annee & "\" & Me.NOAffaire & "\Rapport" & Me.NOAffaire & ".pdf"
file2 = Me.pdf2
File3 = Me.Pdf3
 
If Me.Pdf3 = "" Then
MsgBox "Merci d'attendre la fin du process"
 
Dim oPDF As PdfCreatorObj
Set oPDF = New PdfCreatorObj
oPDF.AddFileToQueue file1
oPDF.AddFileToQueue file2
 
Debug.Print "oPDF isinstancerunning: " & oPDF.IsInstanceRunning ' close Excel and open if true.
 
'On Error GoTo EndSub ' this is commented out for debuging purposes
Dim q As PDFCreator_COM.JobQueue
Set q = New PDFCreator_COM.JobQueue
'q.ReleaseCom
q.Initialize
q.WaitForJobs 3, 10
 
Debug.Print "q.Count: " & q.Count ' here it prints either 1 or 2. Should always be 2.
 
Dim Ret As Long
If q.Count < 3 And Ret < 6 Then
q.Clear
q.ReleaseCom
Ret = Ret + 1 'count the number of times this action returned without proceeding
'GoTo Top
ElseIf Ret >= 6 Then
MsgBox "The merge PDF return a error."
outPath = CurrentProject.Path & "\" & Me.Annee & "\" & Me.NOAffaire & "ERROR_MERGE.pdf"
End If
 
q.MergeAllJobs
 
Dim job As PDFCreator_COM.printJob
 
While q.Count > 0
        Set job = q.NextJob
        job.SetProfileByGuid ("DefaultGuid")
        job.ConvertTo (outPath)
        Debug.Print job.IsFinished
        Debug.Print job.IsSuccessful
        Debug.Print "q.Count3: " & q.Count
Wend
 
'EndSub:
'q.ReleaseCom 'mis en bas
 
MsgBox "Le rapport est prêt dans le dossier LaboRapport de l'affaire, le mail va être préparé dans outlook"
 
'Envoi du rapport pdf par mail
Dim objOutLook As Object
Dim objOutlookMsg As Object
 
Set objOutLook = New Outlook.Application
Set objOutlookMsg = objOutLook.CreateItem(0)
objOutlookMsg.To = Me.Mail 'destinataire
objOutlookMsg.CC = DLookup("[Copie]", "EnvoiMail", "[NomMail] = 'Rapport'") 'cc
'objOutlookMsg.BCC = TxtBCC 'cc caché
objOutlookMsg.Subject = Me.Nomaffaire & "//" & Me.NOAffaire 'sujet
objOutlookMsg.Body = DLookup("[TexteMail]", "EnvoiMail", "[NomMail] = 'Rapport'") 'message
objOutlookMsg.Attachments.Add CurrentProject.Path & "\" & Me.Annee & "\" & Me.NOAffaire & "\RapportFinal" & Me.NOAffaire & N° & ".pdf" 'CheminPJ
objOutlookMsg.display
 
EndSub:
q.ReleaseCom
 
MsgBox "Le mail est prêt"
 
Else
MsgBox "Merci d'attendre la fin du process"
 
oPDF.AddFileToQueue file1
oPDF.AddFileToQueue file2
oPDF.AddFileToQueue File3
 
Debug.Print "oPDF isinstancerunning: " & oPDF.IsInstanceRunning ' close Excel and open if true.
 
'On Error GoTo EndSub ' this is commented out for debuging purposes
'Dim q As PDFCreator_COM.JobQueue
'Set q = New PDFCreator_COM.JobQueue
'q.ReleaseCom
q.Initialize
q.WaitForJobs 3, 10
 
Debug.Print "q.Count: " & q.Count ' here it prints either 1 or 2. Should always be 2.
 
If q.Count < 3 And Ret < 6 Then
q.Clear
q.ReleaseCom
Ret = Ret + 1 'count the number of times this action returned without proceeding
'GoTo Top
ElseIf Ret >= 6 Then
MsgBox "The merge PDF return a error."
outPath = CurrentProject.Path & "\" & Me.Annee & "\" & Me.NOAffaire & "ERROR_MERGE.pdf"
End If
 
q.MergeAllJobs
 
While q.Count > 0
        Set job = q.NextJob
        job.SetProfileByGuid ("DefaultGuid")
        job.ConvertTo (outPath)
        Debug.Print job.IsFinished
        Debug.Print job.IsSuccessful
        Debug.Print "q.Count3: " & q.Count
Wend
 
'EndSub:
'q.ReleaseCom 'mis en bas
 
MsgBox "Le rapport est prêt dans le dossier LaboRapport de l'affaire, le mail va être préparé dans outlook"
 
'Envoi du rapport pdf par mail
Set objOutLook = New Outlook.Application
Set objOutlookMsg = objOutLook.CreateItem(0)
objOutlookMsg.To = Me.Mail 'destinataire
objOutlookMsg.CC = DLookup("[Copie]", "EnvoiMail", "[NomMail] = 'Rapport'") 'cc
'objOutlookMsg.BCC = TxtBCC 'cc caché
objOutlookMsg.Subject = Me.Nomaffaire & "//" & Me.NOAffaire 'sujet
objOutlookMsg.Body = DLookup("[TexteMail]", "EnvoiMail", "[NomMail] = 'Rapport'") 'message
objOutlookMsg.Attachments.Add CurrentProject.Path & "\" & Me.Annee & "\" & Me.NOAffaire & "\RapportFinal" & Me.NOAffaire & N° & ".pdf" 'CheminPJ
objOutlookMsg.display
 
MsgBox "Le mail est prêt"
End If
End Sub

**tee_grandbois** · 06/03/2024, 12h22

bonjour,

Oui j'ai essayé toutes les possibilités Me.pdf3 = "" then ou Is Null etc.; message : erreur d'exécution 94 utilisation incorrect de Null

il faudrait préciser sur quelle ligne de code le message d'erreur survient

**alea83** · 08/03/2024, 13h57

Bonjour,

Merci de me répondre, cela se passe sur Me.Pdf3

**tee_grandbois** · 08/03/2024, 14h16

bonjour,

Merci de me répondre, cela se passe sur Me.Pdf3

certes, mais ta réponse (Me.Pdf3) n'indique pas une ligne de code mais un bout d'instruction

Nom : _1.JPG
Affichages : 43
Taille : 42,2 Ko

as-tu remarqué que le code que tu as posté était numéroté ? c'est la ligne 10 ou 12 ?
Ce n'est pas le cas sur Access mais la ligne en erreur est surlignée en jaune dans la fenêtre VBA

**alea83** · 08/03/2024, 14h31

Re,

Oui c'est la ligne 10 ou il me met en commentaire qu'il n'a pas de valeur justement.. c'est un champ de mon formulaire qui doit contenir le chemin d'un fichier..

**tee_grandbois** · 08/03/2024, 15h00

si tu déclares file2 et file3 en String, il ne pourront accepter de valeur nulle, donc soit tu les déclares en Variant ET tu peux laisser le test sur la valeur nulle de Me.Pdf3 (encore qu'il est préférable de tester la variable valorisée, c'est à dire file3):

Code :

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

1
2
3
4
5
Dim file1 As String
Dim file2 As Variant
Dim file3 As Variant
... 'plus loin
If isnull(Me.Pdf3) Then

soit tu laisses la déclaration en String mais tu fais en sorte que si tu as du nul, tu remplaces par vide avec Nz() lorsque tu les valorises:

Code :

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

1
2
file2 = NZ(Me.pdf2, "")
File3 = Nz(Me.Pdf3, "")

**alea83** · 08/03/2024, 15h20

Re Bonjour,

J'ai essayé les deux et malheureusement j'ai le même message ci-dessous :

Voilà le message d'erreur
Nom : ScreenShot_20240308151815.jpeg
Affichages : 41
Taille : 12,4 Ko

Nom : ScreenShot_20240308151815.jpeg
Affichages : 41
Taille : 12,4 Ko

**tee_grandbois** · 08/03/2024, 15h43

ça me fais une belle jambe si je n'ai TOUJOURS PAS l'instruction qui provoque l'erreur qui, soit dit en passant, n'a rien à voir avec le problème du départ ... là c'est plus un problème avec PDFCreator et sa file d'attente d'impression

**alea83** · 08/03/2024, 15h58

Re,

Oui ca bloque sur q.MergeAllJobs

Le code fonctionne trés bien dés qu'il y a les deux champs pdf2 et pdf3 qui sont remplis

**tee_grandbois** · 08/03/2024, 16h26

Oui ca bloque sur q.MergeAllJobs

attend que je cherche un peu où ça se trouve .... ligne 107, donc

je ne sais pas, peut être faut-il conditionner l'insertion des fichiers, car si il sont vides à quoi bon les ajouter dans la file ?

Code :

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

1
2
3
If file1<> "" then oPDF.AddFileToQueue file1
If file2<> "" then oPDF.AddFileToQueue file2
If file3<> "" then oPDF.AddFileToQueue File3

**alea83** · 08/03/2024, 16h47

Re,

Parce qu'il y a des fois il y aura 2 pdf et d'autres fois 3..
Je vais tester le dernier post

**tee_grandbois** · 08/03/2024, 17h09

~~as-tu testé ?~~ oui, c'est mieux de tester avant de répondre

**alea83** · 08/03/2024, 17h25

Re Bonjour,

Je viens de tester et toujours pareil. Je vais essayer avec empty au cas ou

**tee_grandbois** · 08/03/2024, 17h46

non, inutile, ce sont des variables ... en relisant ton code je viens de comprendre que ce que je t'ai dit de faire pour les 3 fichiers ne sert à rien ....