Gộp file pdf theo thứ tự bằng danh sách trong excel

[VuVanHao]

+ Mục đích: In n file pdf trong 1 thư mục có m file pdf (n<=m)

+ Điều kiện: In theo thứ tự lần lượt file có tên trong cột B (Từ B2 đến hết). Tên file pdf trùng với tên file ở cột B. Trường hợp file có tên trong cột B chưa có trong thư mục chứa file pdf (Ở ví dụ là file tên A9) thì in file tên A0 để thay thế.

+ Cách thức giải quyết: Trước mình đã được thành viên giaiphap giúp đỡ code in từng file pdf theo thứ tự trên. Nhưng có nhược điểm là sẽ tạo ra hàng loạt lệnh in và thứ tự các file in sẽ bị đảo lộn. Mình đã thêm thời gian chờ cho từng lệnh in nhưng nhiều trường hợp vẫn không hiệu quả, và nếu file pdf chưa có trong danh sách in cũng không phát hiện ra được.

+ Phương án mới: Mình nghĩ sẽ gộp các file theo thứ tự in, file nào chưa có sẽ để file pdf trắng để phát hiện (file tên A0). Sau đó mới in file đã được gộp đó.

Mình tìm trên mạng thì chỉ có code gộp file pdf thông qua chương trình đọc file pdf là acrobat.Nhưng code chỉ gộp nguyên cả thư mục chứa file mà không chọn lọc cũng như không theo thứ tự mình muốn.

Xin giúp đỡ: Mong mọi người giúp đỡ sửa code để có thể chạy được theo phương án mới.
Anh chị nếu không cài acrobat có thể sửa code dùm để em test thử ạ.
Xin cảm ơn rất nhiều ạ.
Code trong file như sau ạ.

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)
        .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")
' ZVI:2013-08-27 http://www.vbaexpress.com/forum/showthread.php?47310-Need-code-to-merge-PDF-files-in-a-folder-using-adobe-acrobat-X
' Reference required: VBE - Tools - References - Acrobat
    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)
        ' Check PDF file presence
        If Dir(p & Trim(a(i))) = "" Then
            MsgBox "File not found" & vbLf & p & a(i), vbExclamation, "Canceled"
            Exit For
        End If
        ' Open PDF document
        Set PartDocs(i) = CreateObject("AcroExch.PDDoc")
        PartDocs(i).Open p & Trim(a(i))
        If i Then
            ' Merge PDF to PartDocs(0) document
            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

 

[befaint]

@ Thớt và những ai còn cần vào đọc bài này.

Với thư viện này, chỉ cần liệt kê danh sách các tập tin PDF cần gộp vào cột A rồi ấn nút là xong.

[ Python và ứng dụng ] Thư viện VBA gộp và tạo mật khẩu files PDF hàng loạt siêu bảo mật

[ Python và ứng dụng ] Thư viện VBA gộp và tạo mật khẩu files PDF hàng loạt siêu bảo mật. Tiếp một ứng dụng của Python làm thư viện cho VBA: Gộp và tạo mật khẩu files PDF hàng loạt siêu bảo mật. Thư viện vô cùng hữu ích cho công việc lập hồ sơ xuất PDF hàng loạt rồi cần gộp các files PDF lại...

www.giaiphapexcel.com

 

[pham ha 94]

Mình cũng có nhu cầu tương tự chủ thớt, không biết bạn tìm thấy lối ra chưa
Ví dụ: mình có 5 file ( mỗi ngày 1 file). Trong 1 file thì có danh sách KH khác nhau, giờ muốn ghép lại theo thứ tự mong muốn trong file excel và in ra theo đúng thứ tự này. Nếu in thủ công từng trang hoặc in ra xong ghép lại từng tờ thì nhọc quá

 

[VuVanHao]

@pham ha 94 bài #21 bên trên là lời giải đó bạn