Fusionner pdf

Bonjour,

Je sollicite à nouveau votre aide, en effet j’ai un classeur avec plusieurs centaines de fichiers PDF, ils sont nommés :

ABC DEF 1234567 GH 111111_111_IJKL MNOPQRSTUVW_X.pdf

ZYXWVUTSRNBY_QPON_MLK JIH 1234567 GF 00000000_0000_EDCBA ZYXWUTSRN.pdf

Je souhaite faire un macro pour fusionner les deux fichiers, en sachant que ce qui change à chaque fois c’est : ce qui est souligné

(en récupérant un des deux noms), et après une fois fusionné récupérer le nom des fichiers dans la feuille Excel.

J’ai trouvé un code sur l’internet, cela fonctionne très bien, mais il fusionne tous les fichiers en donnant un autre nom

Je vous remercie par avance de l’aide que vous pouvez m’apporter

Sub Main()

    Const DestFile As String = "MergedFile.pdf" ' <-- change to suit

    Dim MyPath As String, MyFiles As String
    Dim a() As String, i As Long, f As String

     ' Choose the folder or just replace that part by: MyPath = Range("E3")
    With Application.FileDialog(msoFileDialogFolderPicker)
         '.InitialFileName = "C:\Temp\"
        .AllowMultiSelect = False
        If .Show = False Then Exit Sub
        MyPath = .SelectedItems(1)
        DoEvents
    End With

      ' Populate the array a() by PDF file names
    If Right(MyPath, 1) <> "\" Then MyPath = MyPath & "\"
    ReDim a(1 To 2 ^ 14)
    f = Dir(MyPath & "*.pdf")
    While Len(f)
        If StrComp(f, DestFile, vbTextCompare) Then
            i = i + 1
            a(i) = f
        End If
        f = Dir()
    Wend

    ' Merge PDFs
    If i Then
        ReDim Preserve a(1 To i)
        MyFiles = Join(a, ",")
        Application.StatusBar = "Merging, please wait ..."
        Call MergePDFs(MyPath, MyFiles, DestFile)
        Application.StatusBar = False
    Else
        MsgBox "No PDF files found in" & vbLf & MyPath, vbExclamation, "Canceled"
    End If

End Sub

Sub MergePDFs(MyPath As String, MyFiles As String, Optional DestFile As String = "MergedFile.pdf")

    Dim a As Variant, i As Long, n As Long, ni As Long, p As String
    Dim AcroApp As New Acrobat.AcroApp, PartDocs() As Acrobat.CAcroPDDoc

    If Right(MyPath, 1) = "\" Then p = MyPath Else p = MyPath & "\"
    a = Split(MyFiles, ",")
    ReDim PartDocs(0 To UBound(a))

    On Error GoTo exit_
    If Len(Dir(p & DestFile)) Then Kill p & DestFile
    For i = 0 To UBound(a)

        If Dir(p & Trim(a(i))) = "" Then
            MsgBox "File not found" & vbLf & p & a(i), vbExclamation, "Canceled"
            Exit For
        End If

        Set PartDocs(i) = CreateObject("AcroExch.PDDoc")
        PartDocs(i).Open p & Trim(a(i))
        If i Then

            ni = PartDocs(i).GetNumPages()
            If Not PartDocs(0).InsertPages(n - 1, PartDocs(i), 0, ni, True) Then
                MsgBox "Cannot insert pages of" & vbLf & p & a(i), vbExclamation, "Canceled"
            End If
            ' Calc the number of pages in the merged document
            n = n + ni
            ' Release the memory
            PartDocs(i).Close
            Set PartDocs(i) = Nothing
        Else
            ' Calc the number of pages in PartDocs(0) document
            n = PartDocs(0).GetNumPages()
        End If
    Next

    If i > UBound(a) Then
        ' Save the merged document to DestFile
        If Not PartDocs(0).Save(PDSaveFull, p & DestFile) Then
            MsgBox "Cannot save the resulting document" & vbLf & p & DestFile, vbExclamation, "Canceled"
        End If
    End If

exit_:

    ' Inform about error/success
    If Err Then
        MsgBox Err.Description, vbCritical, "Error #" & Err.Number
    ElseIf i > UBound(a) Then
        MsgBox "The resulting file is created:" & vbLf & p & DestFile, vbInformation, "Done"
    End If

    ' Release the memory
    If Not PartDocs(0) Is Nothing Then PartDocs(0).Close
    Set PartDocs(0) = Nothing

    ' Quit Acrobat application
    AcroApp.Exit
    Set AcroApp = Nothing

End Sub

bonjour,

quelqu'un aurait il une idée pour me venir en aide

Merci

Bonjour,

pensez vous qu'il est préférable que j'abandonne cette idée de code de fusion et partir vers autre chose et si c'est le cas auriez vous une idée à me soumettre

Merci par avance de votre aide précieuse