Set password file PDF hàng loạt bằng VBA

Chia sẻ bởi:hands
★★★★★
Quảng cáo

Hiện tại mình đang nghiên cứu việc set password file PDF hàng loạt bằng VBA, mục đích làm phiếu lương. Mình có tham khảo một số cách trên google nhưng vẫn chưa tìm được code phù hợp. Không biết bạn nào đã nghiên cứu vấn đề này thì chia sẽ giúp mình nhá. Cám ơn nhiều.

Ref: [URL="http://answers.microsoft.com/en-us/msoffice/forum/msoffice_word-mso_win10/save-password-protected-pdf-file-with-vba/e3b0be70-d7a5-421b-888f-980d35386c40?auth=1"]answers.microsoft.com/en-us/msoffice/forum/msoffice_word-mso_win10/save-password-protected-pdf-file-with-vba/e3b0be70-d7a5-421b-888f-980d35386c40?auth=1
1593404920
Ah quên nói về yêu cầu của mình. Nó khá đơn giản:
1. Các file PDF được chứa trong 1 folder chỉ định
2. Code có nhiệm vụ truy xuất lần lượt các file PDF để setpassword theo thông tin tại một trường thông tin được ghi tại một Sheet.
Chỉ vậy thôi 🙂

Bạn có vài lựa chọn.
Hoặc bạn tự học viết code trong các ngôn ngữ khác. Hoặc bạn dùng code của người khác viết. Tất nhiên bạn phải đính kèm thư viện, tập tin EXE của người ta vì code không tự nhiên làm việc, nó phải chạy trên một nền tảng nào đó. Tất nhiên bạn phải phụ thuộc vào người ta. Có thể phải trả phí, phải đăng ký. Nếu miễn phí và không phải đăng ký thì ít ra là phải tin tưởng là code của người ta không làm gì "bí mật" sau lưng ta.
Có một cách không phải cài gì, chỉ cần thay đổi yêu cầu. Thực ra bạn chỉ cần gửi PDF cho người ta và sao cho chỉ người ta mở được. Vậy thì đâu nhất thiết PDF phải có mật khẩu? Có thể nén PDF với mật khẩu thì cũng chỉ người nhận mới mở được vì chỉ họ mới biết mật khẩu. Nói là không phải cài gì cũng không đúng, nhưng vd. 7-zip thì dù bạn chưa làm gì với PDF thì bạn đã cài 7-zip từ đời nào rồi, nên bây giờ không phải cài gì thêm. Và cả thế giới dùng 7-zip nên tôi tin tưởng nó hơn là sản phẩm của ông A nào đó.

Nếu bạn vẫn muốn tạo PDF với mật khẩu thì bạn hãy dừng ở đây.

Nếu bạn muốn chạy code để tạo hàng loạt ZIP với mật khẩu từ PDF thì:

1. Nếu chưa cài thì tải 7-zip về và cài đặt.

2. code như sau, chạy sub test

Sub PasswordToPdf(ByVal pdfFullName As String, ByVal strPassword As String)
Const str7ZipPath = "C:Program Files7-Zip7z.exe"
Dim strDestFileName As String, strCmd As String
    strDestFileName = Replace(pdfFullName, ".pdf", ".zip")
    strCmd = str7ZipPath & " -p" & strPassword & " a -tzip """ & strDestFileName & """ """ & pdfFullName & """"   
    Shell strCmd
End Sub

Sub test()
    PasswordToPdf ThisWorkbook.Path & "hichic.pdf", "ngaymaiemdi"
End Sub

Ở máy tôi sau khi cài thì đường dẫn là "C:Program Files7-Zip7z.exe". Nếu cần thì sửa lại ở hằng số str7ZipPath. Nếu có nhiều tập tin PDF với nhiều mật khẩu thì trong sub test gọi code chính trong vòng lặp.

Function Create_PDF(Myvar As Object, FixedFilePathName As String, _
                        OverwriteIfFileExist As Boolean, Pwd As String) As String
    Dim FileFormatstr As String, oPdf As String
    Dim Fname As Variant
    Dim fTemp As String, cmdStr As String
    fTemp = Environ("Temp") & "" & "Temp.Pdf"
    'Test If the Microsoft Add-in is installed
    If Dir(Environ("commonprogramfiles") & "Microsoft SharedOFFICE" _
         & Format(Val(Application.Version), "00") & "EXP_PDF.DLL") <> "" Then

If FixedFilePathName = "" Then
            'Open the GetSaveAsFilename dialog to enter a file name for the pdf
            FileFormatstr = "PDF Files (*.pdf), *.pdf"
            Fname = Application.GetSaveAsFilename("", filefilter:=FileFormatstr, Title:="Create PDF")

'If you cancel this dialog Exit the function
            If Fname = False Then Exit Function
        Else
            Fname = FixedFilePathName
        End If

'If OverwriteIfFileExist = False we test if the PDF
        'already exist in the folder and Exit the function if that is True
        If OverwriteIfFileExist = False Then
            If Dir(Fname) <> "" Then Exit Function
        End If

'Now the file name is correct we Publish to PDF
        'On Error Resume Next
        Myvar.ExportAsFixedFormat _
                Type:=xlTypePDF, _
                FileName:=fTemp, _
                Quality:=xlQualityStandard, _
                IncludeDocProperties:=True, _
                IgnorePrintAreas:=False, _
                OpenAfterPublish:=False

fTemp = """" & fTemp & """"                           'Putting extra "" around for command Parameter.
        oPdf = """" & Fname & """"
        Pwd = """" & Pwd & """"
                                                              'Making Command String for making protected PDFs Using PDFtk tool.
        cmdStr = "pdftk " & fTemp _
                          & " Output " & oPdf _
                          & " User_pw " & Pwd _
                          & " Allow AllFeatures"
        Shell cmdStr, vbHide                                  'Executing PDFtk Command.
        Application.Wait DateAdd("s", 2, Now)                 'Allowing 2 secs for command to execute.
        Kill Replace(fTemp, """", "")
        'On Error GoTo 0

'If Publish is Ok the function will return the file name
        If Dir(Fname) <> "" Then Create_PDF = Fname
    End If
End Function

Hàm sửa lại bỏ tham số OpenPDFAfterPublish (Tham số này True nếu muốn tạo xong sẽ mở file luôn), do nguyên tắc của hàm là tạo ra file PDF ở thư mục tạm, xong copy file PDF vừa tạo xong đó đến đường dẫn người dùng chọn và tạo Password cho file PDF này, tiếp theo sẽ xóa file PDF tạm (File đã tạo ra ở thư mục tạm) này, nhưng lỡ người dụng đặt tham số OpenPDFAfterPublish=true thì sẽ xảy ra lỗi (Do xóa file đang mở). Chính vì điều này mà tôi bỏ đi tham số này.
Ta dùng code sau để tạo file PDF có tên abc.pdf nằm cùng thư mục với file đang sử dụng và có mật khẩu mở file là 123:

MsgBox Create_PDF(Sheet2, ThisWorkbook.Path & "abc.pdf", True, "123")

Lưu ý: Tải và cài đặt PDFtk Free trước khi dùng code.
https://www.pdflabs.com/tools/pdftk-the-pdf-toolkit/

Khoá học Trưởng phòng nhân sự
Khóa học SprinGO phù hợp

Khoá học Trưởng phòng nhân sự

Nguồn nhân lực là một trong Tứ trụ kinh doanh của doanh nghiệp, có tác động tới sự tồn tại và phát triển bền...

Xem khóa học
★★★★★ 5 ★ 1 👤 0 ▥ 0
Quảng cáo

Bạn nên đọc

Leave a Reply

Your email address will not be published. Required fields are marked *

Quảng cáo

Cũ vẫn chất

Xem thêm