Imprimer les PDF d'un dossier et ses sous-dossiers
T
Bonjour à tous,
Pour me simplifier la tâche j'aimerai créer une macro pour imprimer les PDF contenus dans un dossier ainsi que ceux présents dans les sous-dossiers.
Or je n'arrive pas à imprimer les PDF des sous-dossiers avec la macro que j'ai pu trouver sur le net...
Pourriez vous m'aider svp ?
Option Explicit
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Const SW_SHOWNORMAL = 1
Dim NbFichiers As Long
Dim Tableau() As String
Const Dossier As String = "C:\Users\*****\Documents\Nouveau dossier (2)"
Sub Tst()
Dim hwnd As Long
Dim i As Long
Dim DossierOk As String
DossierOk = Dossier
If Right(DossierOk, 1) <> "\" Then DossierOk = Dossier & "\"
ListeFichiers DossierOk, "pdf"
If NbFichiers > 0 Then
For i = 1 To UBound(Tableau)
ShellExecute hwnd, "print", DossierOk & Tableau(i), "", "", SW_SHOWNORMAL
Next
End If
End Sub
Private Sub ListeFichiers(ByVal NomDossierSource As String, ByVal Extension As String)
Dim NomFichier As String
NomFichier = Dir(NomDossierSource & "*." & Extension)
Erase Tableau
NbFichiers = 0
Do While Len(NomFichier) > 0
NbFichiers = NbFichiers + 1
ReDim Preserve Tableau(1 To NbFichiers)
Tableau(NbFichiers) = NomFichier
NomFichier = Dir()
Loop
End Sub