Nối nhiều file pdf bằng code vba

Chia sẻ bởi:hands

★★★★★

‹ Tạo kế hoạch Bảo dưỡng tự động... Hỏi công thức tính tiền lãi thu... ›

Quảng cáo

Có thư mục và file đính kèm.

Mình có code VBA thu nhặt được ở mấy trang web nước ngoài về sửa lại để dùng, Vấn đề mình gặp phải là nó nối các file trong thư mục KHÔNG theo thứ tự như mong muốn. Có cao thủ nào gúp mình không. Có thư mục và file đính kèm.

Sub Noifile()
   Myfolder = ActiveWorkbook.Path
    Const DestFile As String = "Mergefiles.pdf"

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

With Application.FileDialog(msoFileDialogFolderPicker)
        .InitialFileName = Myfolder & "Copy"
         MyPath = Myfolder & "Copy"
      ' 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 "Khong tim thay file nao o day!" & vbLf & MyPath, vbExclamation, "Canceled"
    End If

End Sub

Sub MergePDFs(MyPath As String, MyFiles As String, Optional DestFile As String = "Mergefiles.pdf")
' 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 "Khong the luu file cua ban duoc" & 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 "Da ghep noi file xong: " & "OK"
    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

givenlocation = MyPath
   oldfilename = "Mergefiles.pdf"
   newfilename = "NOI FILE" & ".pdf"

Name givenlocation & oldfilename As givenlocation & newfilename

End Sub

Đổi tên file thành dạng khác xem (ví dụ: page(1).pdf,… page(100).pdf). Cách làm (áp dụng windows7 trở lên):
Chọn danh sách file, chọn sao cho khi nhấn F2 thì rename file đầu tiên, nhập tên file, giữ ctrl rồi nhấn enter.