【Excel VBA】QPDFを使ってPDFにパスワードを設定する方法

Option Explicit

Private Const CMD_TEMPLATE As String = "[QpdfPath] --encrypt [UserPassword] [OwnerPassword] 256 -- [PdfInputPath] [PdfOutputPath]"

Sub test()
    Dim wb As Workbook
    Dim pos As Long
    Dim cmd As String
    Dim wsh As Object
    Dim result As Object
    Dim QpdfPath As String
    Dim BookPath As String
    Dim SheetName As String
    Dim UserPassword As String
    Dim PdfInputPath As String
    Dim PdfOutputPath As String
    
    ' 確認メッセージ
    If MsgBox("PDFを出力します。よろしいですか？", vbYesNo + vbQuestion) = vbNo Then
        Exit Sub
    End If

    ' 画面更新停止
    Application.ScreenUpdating = False

    ' 設定値取得
    QpdfPath = ActiveSheet.Cells(2, 3).Value
    BookPath = ActiveSheet.Cells(3, 3).Value
    SheetName = ActiveSheet.Cells(4, 3).Value
    UserPassword = ActiveSheet.Cells(5, 3).Value

    ' PDFファイルパス生成
    pos = InStrRev(BookPath, ".")
    If pos > 0 Then
        PdfOutputPath = Replace(BookPath, LCase(Mid(BookPath, pos + 1)), "pdf")
    End If
    PdfInputPath = PdfOutputPath & "_tmp.pdf"
    
    ' EXCELをPDF形式で保存
    Set wb = Workbooks.Open(BookPath)
    wb.Worksheets(SheetName).ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfInputPath
    Call wb.Close(SaveChanges:=False)
    
    ' コマンド作成
    cmd = CMD_TEMPLATE
    cmd = Replace(cmd, "[QpdfPath]", QpdfPath)
    cmd = Replace(cmd, "[UserPassword]", UserPassword)
    cmd = Replace(cmd, "[OwnerPassword]", Chr(34) & Chr(34))
    cmd = Replace(cmd, "[PdfInputPath]", Chr(34) & PdfInputPath & Chr(34))
    cmd = Replace(cmd, "[PdfOutputPath]", Chr(34) & PdfOutputPath & Chr(34))
        
    ' コマンド実行（QPDF）
    Set wsh = CreateObject("WScript.Shell")
    Set result = wsh.exec(cmd)
    Do While result.Status = 0
        DoEvents
    Loop
    Set result = Nothing
    Set wsh = Nothing
    
    ' 入力用PDFファイル削除
    Kill PdfInputPath

    ' 画面更新開始
    Application.ScreenUpdating = True
    
    ' 完了メッセージ
    MsgBox ("完了しました。")
    
End Sub