Buongiorno a tutti!

qualcuno si è già cimentato in una sorta di "Stampa Unione" casereccia con salvataggio in Pdf dei vari files ottenuti in diverse cartelle?

Io ho abbozzato una roba tipo questa...

Sub CreaPDF()
   
    Dim oApp As Application
    Dim oDoc As DocumentInspector
   
    Dim DestFile As String
    Dim DestPath As String
   
    Dim Row As Integer
    Dim RowMax As Integer
           
    Dim ShPECU As Worksheet
    Set ShPECU = ThisWorkbook.Worksheets("DatiPerInvioPECU")
           
    'Ciclo sul Foglio PECU
    DestPath = "c:\Pippo"
    Row = 2
    RowMax = 150
    While Row <= RowMax And ShPECU.Range("A" & Row).Value <> ""
       
        'Per ogni riga genera un Pdf nella cartella corretta con i Dati Specifici (Tipo stampa Unione)
        Set oApp = GetObject(, "Word.Application")
        If oApp Is Nothing Then
            Set oApp = New Word.Application
        End If
        With oApp
            .Visible = True
            Set oDoc = .Documents.Open("c:\pippo\lettera.doc")                             'Apertura Documento Word
            .Selection.Goto What:=wdGoToBookmark, Name:="Class"
            .Selection.Delete Unit:=wdCharacter, Count:=1
            .Selection.InsertAfter ShPECU.Range("F" & Row).Value
            .Selection.Goto What:=wdGoToBookmark, Name:="Dirigente"
            .Selection.Delete Unit:=wdCharacter, Count:=1
            .Selection.InsertAfter ShPECU.Range("G" & Row).Value
            .Selection.Goto What:=wdGoToBookmark, Name:="FraseOggetto"
            .Selection.Delete Unit:=wdCharacter, Count:=1
            .Selection.InsertAfter ShPECU.Range("E" & Row).Value
            'Salva in Pdf
            DestFile = DestPath & "\" & Left(ShPECU.Range("A" & Row).Value, 1) & "_" &   ShPECU.Range("B" & Row).Value & "Lettera"
            oDoc.ExportAsFixedFormat OutputFilename:=DestFile & "" & s & ".pdf", ExportFormat:=17
            oDoc.Close True                                                                                                                                                                                                                 'Dhiusura Documento
            .Quit                                                                                                                                                                                                                           'Chiusura Applicazione
                  
        End With
       
        Set oDoc = Nothing                    ' Libera (disalloca) la Memoria
        Set oApp = Nothing                    ' Libera (disalloca) la Memoria
       
        'Incrementa la Riga
        Row = Row + 1
       
    Wend
End Sub