Create & Secure PDFS with Excel

[Ottsel]

I currently have sheet names listed on my "Password" sheet within excel. Column A contains the sheet names I want to generate a PDF of and column B, in the same row, contains the password I want to place onto the newly generated PDF, but I've been encountering numerous problems. I did some searching and found a thread that recommended one way, but I cannot get it to add a password onto the newly generated PDFs for security reasons. I would just add them manually, but its just a large number of PDF's it would save a large amount time if I could get this to work.
Here's what I got so far. It generates the PDFS perfectly, but it does not secure them with the password I want.

Sub GenerateSecureDocuments()

    Dim ws As Worksheet
    Dim sheetName As String
    Dim savePath As String
    Dim lastRow As Long
    Dim cell As Range
    Dim password As String
    Dim currentSheet As Worksheet

    ' ...Set reference to the "Password" worksheet
    Set ws = ThisWorkbook.Sheets("Password")

    ' ...Determine the last row in column A (where sheet names are listed)
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

    ' ...The guy wanted the PDF's to save where this document is located
    savePath = ThisWorkbook.Path & "\"

    ' ...Loop through each sheet name in column A starting from A2
    For Each cell In ws.Range("A2:A" & lastRow)

        ' ...Get the sheet name and password from columns A and B
        sheetName = cell.Value
        password = ws.Cells(cell.Row, "B").Value

        ' ...Check if the sheet exists in the workbook
        On Error Resume Next
        Set currentSheet = ThisWorkbook.Sheets(sheetName)
        On Error GoTo 0

        If Not currentSheet Is Nothing Then
            ' ...Export the sheet as a PDF
            currentSheet.ExportAsFixedFormat Type:=xlTypePDF, _
                                           Filename:=savePath & sheetName & ".pdf", _
                                           Quality:=xlQualityStandard, _
                                           IncludeDocProperties:=True, _
                                           IgnorePrintAreas:=False, _
                                           OpenAfterPublish:=False

            ' ...Add password to the PDF using the shortcut
            Call SecurePDFWithPassword(savePath & sheetName & ".pdf", password)
        End If

        ' ...Reset the currentSheet to Nothing for the next iteration
        Set currentSheet = Nothing
    Next cell

    ' ...Notify the user that the process is complete
    MsgBox "Document(s) created and secured!", vbInformation + vbOKOnly, "abc Companies"

End Sub

Private Sub SecurePDFWithPassword(pdfPath As String, pdfPassword As String)

  Dim AcroApp As Object
  Dim AcroDoc As Object

  On Error GoTo HandleError

  '...Get the full path to the shortcut (assuming it's named "Adobe Acrobat.lnk")
  Dim shortcutPath As String
  shortcutPath = ThisWorkbook.Path & "\Adobe Acrobat.lnk"

  '...Create the COM objects using the shortcut path
  Set AcroApp = CreateObject("WScript.Shell").Exec(shortcutPath).StdOut
  Set AcroDoc = AcroApp.CreateObject("AcroExch.PDDoc")

  If AcroDoc.Open(pdfPath) Then
    Call AcroDoc.SetSecurity(1, pdfPassword, "")
    AcroDoc.Save 1, pdfPath
    AcroDoc.Close
  End If

  AcroApp.Quit
  Set AcroDoc = Nothing
  Set AcroApp = Nothing

  Exit Sub

HandleError:
  MsgBox "Error setting password to PDF: " & Err.Description, vbCritical
End Sub

 

[John_w]

Call AcroDoc.SetSecurity(1, pdfPassword, "") fails with "Object doesn't support this property or method", which means SetSecurity is not a valid method of the Acrobat AcroPDDoc class.

Previously I've tried the code at Secure PDF's generated with Microsoft Access OutputTo, but it doesn't work for me. Note it uses the encryptUsingPolicy method, but nowhere is a password specified.

Perhaps that code, in combination with an Acrobat trusted function might work. That approach is described at How to code Adobe JavaScript, how to code PDF JavaScript - Adobe Acrobat, though I'm not sure where or if a password can be specified.

 

[John_w]

I looked further into securing a PDF with the Acrobat API that comes with Adobe Acrobat Pro, however it seems it's not possible.

Instead, the code below automates the Adobe Acrobat Pro user interface on the currently open PDF using the UIAutomation library. The manual steps automated are: View menu -> Tools -> Protection -> Restrict Editing -> Enter a Permissions password -> Save PDF to create a secured PDF.

Note - you might need to change some of the strings in the modUIAutomation module for your version of Adobe Acrobat Pro, specifically the 'Name' property of controls.

Adobe Acrobat Pro must be set as the default PDF application.

The following references must be set in the VBA editor, via Tools -> References:

Microsoft Shell Controls and Automation​

UIAutomationClient​

1st standard module - modMain

'References required:
'Microsoft Shell Controls and Automation
'UIAutomationClient

'Adobe Acrobat Pro must be set as the default PDF application

Option Explicit


Public Sub GenerateSecureDocuments2()

    Dim ws As Worksheet
    Dim sheetName As String
    Dim savePath As String
    Dim lastRow As Long
    Dim cell As Range
    Dim password As String
    Dim currentSheet As Worksheet

    Dim Sh As Shell32.Shell
    #If VBA7 Then
        Dim AcrobatHwnd As LongPtr
    #Else
        Dim AcrobatHwnd As Long
    #End If
    Dim PDFfullName As String, PDFfileName As String
    Dim SaveAsFile As String
    Dim p As Long
    
    Set Sh = New Shell32.Shell

    savePath = ThisWorkbook.Path & "\"

    Set ws = ThisWorkbook.Sheets("Password")

    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

    'Loop through each sheet name in column A starting from A2
    For Each cell In ws.Range("A2:A" & lastRow)

        'Get the sheet name and password from columns A and B
        sheetName = cell.Value
        password = ws.Cells(cell.Row, "B").Value

        'Check if the sheet exists in the workbook
        On Error Resume Next
        Set currentSheet = ThisWorkbook.Sheets(sheetName)
        On Error GoTo 0

        If Not currentSheet Is Nothing Then
            'Export the sheet as a PDF
            PDFfullName = savePath & sheetName & ".pdf"
            currentSheet.ExportAsFixedFormat Type:=xlTypePDF, _
                                           fileName:=PDFfullName, _
                                           Quality:=xlQualityStandard, _
                                           IncludeDocProperties:=True, _
                                           IgnorePrintAreas:=False, _
                                           OpenAfterPublish:=False
        
            'Open the PDF file in its default application, i.e. Adobe Acrobat Pro
        
            p = InStrRev(PDFfullName, "\")
            PDFfileName = Mid(PDFfullName, p + 1)
            Sh.Namespace(Left(PDFfullName, p)).Items.Item(PDFfileName).InvokeVerb "Open"
        
            'Get the hWnd of the opened PDF
            
            Do
                AcrobatHwnd = Find_App_Window(PDFfileName & "*")
                DoEvents
                Sleep 100
            Loop While AcrobatHwnd = 0
    
            'No 'Save As' file name specified, so the secured PDF will be saved in its existing folder and with its existing file name
            SaveAsFile = ""
    
            'Set the Restrict Editing Permissions password for the PDF
            
            UIAutomation_Restrict_Editing AcrobatHwnd, password, SaveAsFile, True
                
            'Close the opened PDF
            
            Close_Window AcrobatHwnd

        End If

        'Reset the currentSheet to Nothing for the next iteration
        Set currentSheet = Nothing
        
    Next cell

    'Notify the user that the process is complete
    MsgBox "Document(s) created and secured!", vbInformation + vbOKOnly, "abc Companies"

End Sub

2nd standard module - modUIAutomation

'This module contains UIAutomation code.

Option Explicit


'Create a secure PDF by automating the Adobe Acrobat Pro XI menu sequence: View -> Tools -> Protection -> Restrict Editing and setting a Permissions password
'for the currently open PDF and saving the file.
'
'Arguments
'
'AcrobatHwnd            Handle to the Adobe Acrobat Pro application window with the PDF open in it
'PermissionsPassword    Password to use for the Restrict Editing -> Permissions Password
'SaveAsFile             Optional.  If specified it can be the folder path and/or file name to save the secured PDF as.
'                       It has the following meanings:
'                       "" or argument omitted - the secured PDF will be saved in its existing folder with its existing file name
'                       only a folder path is specified - the secured PDF will be saved in the specified folder with its existing file name
'                       only a file name is specified - the secured PDF will be saved in its existing folder with the specified file name
'                       folder path and file name are specified - the secured PDF will be saved in the specified folder with the specified file name
'ReplaceExistingFile    True - replace the specified SaveAsFile, if it exists; False - don't replace the specified SaveAsFile


#If VBA7 Then
Public Function UIAutomation_Restrict_Editing(AcrobatHwnd As LongPtr, PermissionsPassword As String, Optional SaveAsFile As String = "", Optional ReplaceExistingFile As Boolean = True) As String
#Else
Public Function UIAutomation_Restrict_Editing(AcrobatHwnd As Long, PermissionsPassword As String, Optional SaveAsFile As String = "", Optional ReplaceExistingFile As Boolean = True) As String
#End If
   
    Dim UIAuto As IUIAutomation
    Dim AcrobatMain As IUIAutomationElement
    Dim ControlTypeCond As IUIAutomationCondition, NameCond As IUIAutomationCondition, ControlTypeAndNameCond As IUIAutomationCondition
    Dim ProtectionTree As IUIAutomationElement
    Dim RestrictEditingButton As IUIAutomationElement
    Dim PasswordWindow As IUIAutomationElement
    Dim PasswordEdit As IUIAutomationElement
    Dim PasswordInputPattern As IUIAutomationValuePattern
    Dim OpenPattern As IUIAutomationLegacyIAccessiblePattern
    Dim OKButton As IUIAutomationElement
    Dim InvokePattern As IUIAutomationInvokePattern
    Dim SaveButton As IUIAutomationElement
    Dim TreeWalker As IUIAutomationTreeWalker
    Dim PDFwindowTitle As String
        
    'Create UIAutomation object
    
    Set UIAuto = New CUIAutomation
    
    'Get the main Acrobat window of the displayed PDF.  This is a Window control with the class name AcrobatSDIWindow
    
    Set AcrobatMain = UIAuto.ElementFromHandle(ByVal AcrobatHwnd)
    
    AcrobatMain.SetFocus
    DoEvents
    Sleep 200
    
    'Press Alt+V, T, R (View menu -> Tools -> Protection) to display the Protection options within the Tools menu.
    'Restrict Editing is the first item within the Protection options
    
    PressKeys_Alt vbKeyV
    DoEvents
    Sleep 200
    PressKeys_Key vbKeyT
    DoEvents
    Sleep 200
    PressKeys_Key vbKeyR
    DoEvents
    Sleep 200
   
    'Find the Protection item in the Tools panel
    'Name:          "Protection"
    'ControlType:   UIA_TreeItemControlTypeId (0xC368)
    
    Set ControlTypeCond = UIAuto.CreatePropertyCondition(UIA_ControlTypePropertyId, UIA_TreeItemControlTypeId)
    Set NameCond = UIAuto.CreatePropertyCondition(UIA_NamePropertyId, "Protection")
    Set ControlTypeAndNameCond = UIAuto.CreateAndCondition(ControlTypeCond, NameCond)
    Do
        Set ProtectionTree = AcrobatMain.FindFirst(TreeScope_Descendants, ControlTypeAndNameCond)
        DoEvents
        Sleep 200
    Loop While ProtectionTree Is Nothing
    
    'Find the Restrict Editing button within the Protection items
    'Name:          "Restrict Editing"
    'ControlType:   UIA_ButtonControlTypeId (0xC350)
    'LegacyIAccessible.ChildId:  0
    'LegacyIAccessible.DefaultAction:    "Press"

    Set ControlTypeCond = UIAuto.CreatePropertyCondition(UIA_ControlTypePropertyId, UIA_ButtonControlTypeId)
    Set NameCond = UIAuto.CreatePropertyCondition(UIA_NamePropertyId, "Restrict Editing")
    Set ControlTypeAndNameCond = UIAuto.CreateAndCondition(ControlTypeCond, NameCond)
    Set RestrictEditingButton = ProtectionTree.FindFirst(TreeScope_Descendants, ControlTypeAndNameCond)
    
    If Not RestrictEditingButton Is Nothing Then
        
        'Click Restrict Editing button until the Password dialogue window appears
        
        Do
        
            RestrictEditingButton.SetFocus
            PressKeys_Key vbKeyReturn
            
            DoEvents
            Sleep 100
        
            'Get Password dialogue window
            'Name:          "Password"
            'ControlType:   UIA_WindowControlTypeId (0xC370)
        
            Set ControlTypeCond = UIAuto.CreatePropertyCondition(UIA_ControlTypePropertyId, UIA_WindowControlTypeId)
            Set NameCond = UIAuto.CreatePropertyCondition(UIA_NamePropertyId, "Password")
            Set ControlTypeAndNameCond = UIAuto.CreateAndCondition(ControlTypeCond, NameCond)
            Set PasswordWindow = AcrobatMain.FindFirst(TreeScope_Descendants, ControlTypeAndNameCond)
            DoEvents
            Sleep 100
        
        Loop While PasswordWindow Is Nothing
        
        'Get Permissions Password edit control
        'Name:          "Permissions Password:"
        'ControlType:   UIA_EditControlTypeId (0xC354)
    
        Set ControlTypeCond = UIAuto.CreatePropertyCondition(UIA_ControlTypePropertyId, UIA_EditControlTypeId)
        Set NameCond = UIAuto.CreatePropertyCondition(UIA_NamePropertyId, "Permissions Password:")
        Set ControlTypeAndNameCond = UIAuto.CreateAndCondition(ControlTypeCond, NameCond)
        Set PasswordEdit = PasswordWindow.FindFirst(TreeScope_Descendants, ControlTypeAndNameCond)
    
        'Enter the password in Password input box
        
        Set PasswordInputPattern = PasswordEdit.GetCurrentPattern(UIA_ValuePatternId)
        PasswordEdit.SetFocus
        PasswordInputPattern.SetValue PermissionsPassword
        
        'Get Confirm Password edit control
        'Name:          "Confirm Password:"
        'ControlType:   UIA_EditControlTypeId (0xC354)
                
        Set ControlTypeCond = UIAuto.CreatePropertyCondition(UIA_ControlTypePropertyId, UIA_EditControlTypeId)
        Set NameCond = UIAuto.CreatePropertyCondition(UIA_NamePropertyId, "Confirm Password:")
        Set ControlTypeAndNameCond = UIAuto.CreateAndCondition(ControlTypeCond, NameCond)
        Set PasswordEdit = PasswordWindow.FindFirst(TreeScope_Descendants, ControlTypeAndNameCond)
        
        'Enter the password in Confirm Password input box
        
        Set PasswordInputPattern = PasswordEdit.GetCurrentPattern(UIA_ValuePatternId)
        PasswordEdit.SetFocus
        PasswordInputPattern.SetValue PermissionsPassword
                
        'Find and click OK button to set the password
        'Name:          "OK"
        'ControlType:   UIA_ButtonControlTypeId (0xC350)
                
        Set ControlTypeCond = UIAuto.CreatePropertyCondition(UIA_ControlTypePropertyId, UIA_ButtonControlTypeId)
        Set NameCond = UIAuto.CreatePropertyCondition(UIA_NamePropertyId, "OK")
        Set ControlTypeAndNameCond = UIAuto.CreateAndCondition(ControlTypeCond, NameCond)
        Set OKButton = PasswordWindow.FindFirst(TreeScope_Descendants, ControlTypeAndNameCond)
                
        OKButton.SetFocus
        Set InvokePattern = OKButton.GetCurrentPattern(UIA_InvokePatternId)
        InvokePattern.Invoke
        DoEvents
        Sleep 500
        
        'After clicking OK, the following window is displayed:
        
        'Adobe Acrobat
        '
        '   Security settings will not be applied to the document until you save the document.  You will be able to
        '   continue to change security settings until you close the document.
        '                                                                           [ OK ]
    
        'Find the dialogue window
        'Name:          "Adobe Acrobat"
        'ControlType:   UIA_WindowControlTypeId (0xC370)
    
        Set ControlTypeCond = UIAuto.CreatePropertyCondition(UIA_ControlTypePropertyId, UIA_WindowControlTypeId)
        Set NameCond = UIAuto.CreatePropertyCondition(UIA_NamePropertyId, "Adobe Acrobat")
        Set ControlTypeAndNameCond = UIAuto.CreateAndCondition(ControlTypeCond, NameCond)
        Set PasswordWindow = AcrobatMain.FindFirst(TreeScope_Descendants, ControlTypeAndNameCond)
        
        'Find and click the OK button
        'Name:          "OK"
        'ControlType:   UIA_ButtonControlTypeId (0xC350)

        Set ControlTypeCond = UIAuto.CreatePropertyCondition(UIA_ControlTypePropertyId, UIA_ButtonControlTypeId)
        Set NameCond = UIAuto.CreatePropertyCondition(UIA_NamePropertyId, "OK")
        Set ControlTypeAndNameCond = UIAuto.CreateAndCondition(ControlTypeCond, NameCond)
        Set OKButton = PasswordWindow.FindFirst(TreeScope_Descendants, ControlTypeAndNameCond)
        OKButton.SetFocus
        Set InvokePattern = OKButton.GetCurrentPattern(UIA_InvokePatternId)
        InvokePattern.Invoke
        DoEvents
        Sleep 500
    
        'Press Ctrl+S to open Save As dialogue
        
        PressKeys_Ctrl vbKeyS
        
        UIAutomation_Restrict_Editing = Save_As_File(UIAuto, AcrobatMain, SaveAsFile, ReplaceExistingFile)
    
        'If the secure PDF file was saved then wait until the PDF window title contains ".pdf (SECURED)"
        
        If UIAutomation_Restrict_Editing Then
            Do
                PDFwindowTitle = Window_Title(AcrobatHwnd)
                DoEvents
                Sleep 200
            Loop Until InStr(1, PDFwindowTitle, ".pdf (SECURED)", vbTextCompare) > 0
        End If
    
    Else
    
        MsgBox "Restrict Editing button not found in Tools -> Protection.  Is this PDF already secured?", vbExclamation
        
        UIAutomation_Restrict_Editing = False
    
    End If
    
End Function


Private Function Save_As_File(UIAuto As IUIAutomation, AcrobatMain As IUIAutomationElement, SaveAsFile As String, ReplaceExistingFile As Boolean) As Boolean
    
    Dim ControlTypeCond As IUIAutomationCondition
    Dim NameCond As IUIAutomationCondition
    Dim ControlTypeAndNameCond As IUIAutomationCondition
    Dim SaveAsWindow As IUIAutomationElement
    Dim SaveButton As IUIAutomationElement
    Dim FileNameInput As IUIAutomationElement
    Dim FileNameInputPattern As IUIAutomationValuePattern
    Dim InvokePattern As IUIAutomationInvokePattern
    Dim Desktop As IUIAutomationElement
    Dim ProgressBar As IUIAutomationElement
    Dim AddressToolBar As IUIAutomationElement
    Dim SaveAsButton As IUIAutomationElement
    Dim CancelButton As IUIAutomationElement
    Dim FileExistsWindow As IUIAutomationElement
    Dim ExistingFileText As IUIAutomationElement
    Dim YesOrNoButton As IUIAutomationElement
    Dim folderPath As String, fileName As String, fullFileName As String
    Dim existingFile As String
    Dim p As Long
    
    'Set this function's return value to indicate that the file was saved.  This is the default value.  The return value is False only when an
    'existing file is not replaced
    
    Save_As_File = True
    
    'Find the Save As window, waiting until it exists.  This is a child of the Acrobat SDI window
    'Name:          "Save As"
    'ControlType:   UIA_WindowControlTypeId (0xC370)
    
    Set ControlTypeCond = UIAuto.CreatePropertyCondition(UIA_ControlTypePropertyId, UIA_WindowControlTypeId)
    Set NameCond = UIAuto.CreatePropertyCondition(UIA_NamePropertyId, "Save As")
    Set ControlTypeAndNameCond = UIAuto.CreateAndCondition(ControlTypeCond, NameCond)
    Do
        Set SaveAsWindow = AcrobatMain.FindFirst(TreeScope_Children, ControlTypeAndNameCond)
        DoEvents
        Sleep 100
    Loop While SaveAsWindow Is Nothing
       
    'Find the File name input edit box inside the Save As window
    'Name:          "File name:"
    'ControlType:   UIA_EditControlTypeId (0xC354)

    Set ControlTypeCond = UIAuto.CreatePropertyCondition(UIA_ControlTypePropertyId, UIA_EditControlTypeId)
    Set NameCond = UIAuto.CreatePropertyCondition(UIA_NamePropertyId, "File name:")
    Set ControlTypeAndNameCond = UIAuto.CreateAndCondition(ControlTypeCond, NameCond)
    Set FileNameInput = SaveAsWindow.FindFirst(TreeScope_Descendants, ControlTypeAndNameCond)
    
    'Extract the default file name from the edit box
    
    fileName = FileNameInput.GetCurrentPropertyValue(UIA_ValueValuePropertyId)
    
    'If the caller has specified the 'Save As' PDF file name, then put it in the File name input box in the Save As window,
    'overwriting the existing file name.  Otherwise the File name input box is untouched and the existing file name is used and
    'the PDF will be saved in its existing folder
    
    p = InStrRev(SaveAsFile, "\")
    
    If SaveAsFile = "" Or p = 0 Then
    
        'Folder path not specified so read the folder path from the Save As address bar
        
        'Find Progress Bar within the Save As dialogue window.  A child of this contains the PDF's folder path address
        'ControlType:   UIA_ProgressBarControlTypeId (0xC35C)
    
        Set ControlTypeCond = UIAuto.CreatePropertyCondition(UIA_ControlTypePropertyId, UIA_ProgressBarControlTypeId)
        Set ProgressBar = SaveAsWindow.FindFirst(TreeScope_Descendants, ControlTypeCond)
        
        'Name:          "Address: D:\Temp\Excel\PDF\2021"
        'ControlType:   UIA_ToolBarControlTypeId (0xC365)
    
        Set ControlTypeCond = UIAuto.CreatePropertyCondition(UIA_ControlTypePropertyId, UIA_ToolBarControlTypeId)
        Set AddressToolBar = ProgressBar.FindFirst(TreeScope_Descendants, ControlTypeCond)
        
        folderPath = Split(AddressToolBar.GetCurrentPropertyValue(UIA_NamePropertyId), "Address: ")(1)
        If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\"
                
    End If
        
    If SaveAsFile <> "" Then
    
        If p > 0 Then
        
            'Extract folder path from specified file
            
            folderPath = Left(SaveAsFile, p)
        
        End If
    
        If p < Len(SaveAsFile) Then
            'File name specified in - use it
            fileName = Mid(SaveAsFile, p + 1)
        Else
            'File name not specified - use default file name
            SaveAsFile = SaveAsFile & fileName
        End If
        
        'Put the specified file name in the input box

        Set FileNameInputPattern = FileNameInput.GetCurrentPattern(UIA_ValuePatternId)
        FileNameInput.SetFocus
        FileNameInputPattern.SetValue SaveAsFile

        'Alternative code to put the full file name in the input box using IUIAutomationLegacyIAccessiblePattern
        'Same effect as using UIA_ValuePatternId above.
        '
        'Set FileNameInputPatternLegacy = FileNameInput.GetCurrentPattern(UIA_LegacyIAccessiblePatternId)
        'FileNameInputPatternLegacy.Select 1 '1=SELFLAG_TAKEFOCUS
        'FileNameInputPatternLegacy.SetValue fullFileName

        'If the Save button is clicked now, the Save As dialogue thinks the file is being saved in the default folder with the
        'original file name, not the file specified in SaveAsFile.  To overcome this, and use SaveAsFile, put a single space at
        'the start of the file input box containing the full file name

        PressKeys_Key vbKeySpace
        DoEvents
        Sleep 100
       
    End If
    
    If LCase(Right(fileName, 4)) <> ".pdf" Then fileName = fileName & ".pdf"
    fullFileName = folderPath & fileName
    
    Debug.Print "SaveAsFile     = " & SaveAsFile
    Debug.Print "File name      = " & fileName
    Debug.Print "Folder path    = " & folderPath
    Debug.Print "Full file name = " & fullFileName
    
    'Find the Save button inside the Save As window
    'Name:   "Save"
    'ControlType:    UIA_ButtonControlTypeId (0xC350)

    Set ControlTypeCond = UIAuto.CreatePropertyCondition(UIA_ControlTypePropertyId, UIA_ButtonControlTypeId)
    Set NameCond = UIAuto.CreatePropertyCondition(UIA_NamePropertyId, "Save")
    Set ControlTypeAndNameCond = UIAuto.CreateAndCondition(ControlTypeCond, NameCond)
    Set SaveButton = SaveAsWindow.FindFirst(TreeScope_Descendants, ControlTypeAndNameCond)
        
    'Click the Save button to save the PDF
    
    SaveButton.SetFocus
    Set InvokePattern = SaveButton.GetCurrentPattern(UIA_InvokePatternId)
    InvokePattern.Invoke
    DoEvents
    Sleep 500
    
    If Dir(fullFileName) <> vbNullString Then
    
        Set Desktop = UIAuto.GetRootElement
        
        'The file already exists so wait until the Save As warning window appears, with Yes and No buttons
        'Name:          "Save As"
        'ControlType:   UIA_WindowControlTypeId (0xC370)
        
        Set ControlTypeCond = UIAuto.CreatePropertyCondition(UIA_ControlTypePropertyId, UIA_WindowControlTypeId)
        Set NameCond = UIAuto.CreatePropertyCondition(UIA_NamePropertyId, "Save As")
        Set ControlTypeAndNameCond = UIAuto.CreateAndCondition(ControlTypeCond, NameCond)
        Do
            Set FileExistsWindow = Desktop.FindFirst(TreeScope_Descendants, ControlTypeAndNameCond)
            DoEvents
            Sleep 100
        Loop While FileExistsWindow Is Nothing
        
        'Find the text control within the Save As dialogue.  Its name contains the full name of the existing file
        'Name:          "D:\Temp\Excel\PDF\A4 A5 Portrait Landscape pages.pdf
        '               The file already exists.
        '               Replace existing file?"
        'ControlType:   UIA_TextControlTypeId (0xC364)

        Set ControlTypeCond = UIAuto.CreatePropertyCondition(UIA_ControlTypePropertyId, UIA_TextControlTypeId)
        Set ExistingFileText = FileExistsWindow.FindFirst(TreeScope_Descendants, ControlTypeCond)
        existingFile = ExistingFileText.GetCurrentPropertyValue(UIA_NamePropertyId)
        
        'Find the Yes or No button, a child of the Save As dialogue, depending on the replaceExistingFile flag
        'Name:          "Yes"
        'ControlType:   UIA_ButtonControlTypeId (0xC350)
        'AccessKey:     "Alt+y"
        'Name:          "No"
        'ControlType:   UIA_ButtonControlTypeId (0xC350)
        'AccessKey:     "Alt+n"

        Set ControlTypeCond = UIAuto.CreatePropertyCondition(UIA_ControlTypePropertyId, UIA_ButtonControlTypeId)
        Set NameCond = UIAuto.CreatePropertyCondition(UIA_NamePropertyId, IIf(ReplaceExistingFile, "Yes", "No"))
        Set ControlTypeAndNameCond = UIAuto.CreateAndCondition(ControlTypeCond, NameCond)
        Set YesOrNoButton = FileExistsWindow.FindFirst(TreeScope_Children, ControlTypeAndNameCond)
        
        'Set focus on the Yes or No button and click it

        YesOrNoButton.SetFocus
        DoEvents
        Sleep 100
        Set InvokePattern = YesOrNoButton.GetCurrentPattern(UIA_InvokePatternId)
        InvokePattern.Invoke
        DoEvents
        Sleep 200
        
        If Not ReplaceExistingFile Then
        
            'Find and click the Cancel button in the Save As dialogue
            'Name:          "Cancel"
            'ControlType:   UIA_ButtonControlTypeId (0xC350)

            Set ControlTypeCond = UIAuto.CreatePropertyCondition(UIA_ControlTypePropertyId, UIA_ButtonControlTypeId)
            Set NameCond = UIAuto.CreatePropertyCondition(UIA_NamePropertyId, "Cancel")
            Set ControlTypeAndNameCond = UIAuto.CreateAndCondition(ControlTypeCond, NameCond)
            Set CancelButton = SaveAsWindow.FindFirst(TreeScope_Descendants, ControlTypeAndNameCond)
        
            CancelButton.SetFocus
            Set InvokePattern = CancelButton.GetCurrentPattern(UIA_InvokePatternId)
            InvokePattern.Invoke
            DoEvents
            Sleep 200
            
            'Indicate that the file was not saved
            
            Save_As_File = False
        
        End If
       
    End If
    
End Function

3rd standard module - modWinAPI

'This module contains public functions to find a window and get its caption and simulate key presses.

Option Explicit


#If VBA7 Then
    
    'Window functions
    Private Declare PtrSafe Function SetForegroundWindow Lib "user32.dll" (ByVal hWnd As LongPtr) As LongPtr
    Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
    Private Declare PtrSafe Function FindWindowEx Lib "user32.dll" Alias "FindWindowExA" (ByVal hWndParent As LongPtr, ByVal hWndChildAfter As LongPtr, ByVal lpszClass As String, ByVal lpszWindow As String) As LongPtr
    Private Declare PtrSafe Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hWnd As LongPtr, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
    Private Declare PtrSafe Function GetWindow Lib "user32" (ByVal hWnd As LongPtr, ByVal wCmd As Long) As LongPtr
    Private Declare PtrSafe Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hWnd As LongPtr, ByVal lpString As String, ByVal cch As Long) As Long
    Private Declare PtrSafe Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hWnd As LongPtr) As Long
    Private Declare PtrSafe Function GetDesktopWindow Lib "user32" () As LongPtr
    Private Declare PtrSafe Function IsWindowVisible Lib "user32" (ByVal hWnd As LongPtr) As Long
    
    'Keyboard functions
    Private Declare PtrSafe Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
    Private Declare PtrSafe Function MapVirtualKey Lib "user32" Alias "MapVirtualKeyA" (ByVal wCode As Long, ByVal wMapType As Long) As Long

    'Other functions
    Private Declare PtrSafe Sub SleepAPI Lib "kernel32.dll" Alias "Sleep" (ByVal dwMilliseconds As Long)
    Private Declare PtrSafe Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hWnd As LongPtr, ByVal wMsg As Long, ByVal wParam As Long, ByRef lParam As Any) As Long

#Else
    
    'Window functions
    Private Declare Function SetForegroundWindow Lib "user32.dll" (ByVal hWnd As Long) As Long
    Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
    Private Declare Function FindWindowEx Lib "user32.dll" Alias "FindWindowExA" (ByVal hWndParent As Long, ByVal hWndChildAfter As Long, ByVal lpszClass As String, ByVal lpszWindow As String) As Long
    Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hWnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
    Private Declare Function GetWindow Lib "user32" (ByVal hWnd As Long, ByVal wCmd As Long) As Long
    Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
    Private Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hWnd As Long) As Long
    Private Declare Function GetDesktopWindow Lib "user32" () As Long
    Private Declare Function IsWindowVisible Lib "user32" (ByVal hWnd As Long) As Long
    
    'Keyboard functions
    Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
    Private Declare Function MapVirtualKey Lib "user32" Alias "MapVirtualKeyA" (ByVal wCode As Long, ByVal wMapType As Long) As Long

    'Other functions
    Private Declare Sub SleepAPI Lib "kernel32.dll" Alias "Sleep" (ByVal dwMilliseconds As Long)
    Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByRef lParam As Any) As Long

#End If

Private Const AcrobatClassName = "AcrobatSDIWindow"

Private Const KEYEVENTF_KEYDOWN = &H0
Private Const KEYEVENTF_KEYUP = &H2
Private Const VK_MENU = &H12
Private Const VK_LCONTROL = &HA2

Public Const GW_HWNDNEXT = 2
Public Const GW_CHILD = 5

Private Const WM_GETTEXT As Long = &HD
Private Const WM_CLOSE = &H10


Public Sub Sleep(milliseconds As Long)
    SleepAPI milliseconds
End Sub


#If VBA7 Then
Public Sub Get_Acrobat_Window(hWnd As LongPtr, windowCaption As String)
#Else
Public Sub Get_Acrobat_Window(hWnd As Long, windowCaption As String)
#End If

    hWnd = FindWindow(AcrobatClassName, vbNullString)
    
    If hWnd <> 0 Then
        'Debug.Print "Acrobat Hwnd = " & Hex(hWnd)
        windowCaption = String(GetWindowTextLength(hWnd) + 1, Chr$(0))
        GetWindowText hWnd, windowCaption, Len(windowCaption)
        windowCaption = Left$(windowCaption, Len(windowCaption) - 1)
        'Debug.Print windowCaption
    End If

End Sub


'Find the application window with the specified title and return its hWnd
#If VBA7 Then
Public Function Find_App_Window(windowTitleLike As String) As LongPtr
#Else
Public Function Find_App_Window(windowTitleLike As String) As Long
#End If

    #If VBA7 Then
        Dim hWnd As LongPtr
    #Else
        Dim hWnd As Long
    #End If
    Dim thisWindowTitle As String
    Dim foundWindow As Boolean
    
    hWnd = GetWindow(GetDesktopWindow, GW_CHILD)
    foundWindow = False
    
    Do While hWnd <> 0 And Not foundWindow
        thisWindowTitle = Window_Title(hWnd)
        If IsWindowVisible(hWnd) And UCase(thisWindowTitle) Like UCase(windowTitleLike) Then
            foundWindow = True
            'Debug.Print "Window " & Hex(hWnd) & " " & thisWindowTitle
        Else
            hWnd = GetWindow(hWnd, GW_HWNDNEXT)
        End If
    Loop

    Find_App_Window = hWnd
    
End Function


#If VBA7 Then
Public Sub Close_Window(hWnd As LongPtr)
#Else
Public Sub Close_Window(hWnd As Long)
#End If
    
    SendMessage hWnd, WM_CLOSE, 0&, 0&

End Sub


#If VBA7 Then
Public Function Window_Title(hWnd As LongPtr) As String
#Else
Public Function Window_Title(hWnd As Long) As String
#End If

    Dim lngLength As Long
    Dim strBuffer As String
    Dim lngRet As Long
    
    lngLength = GetWindowTextLength(hWnd) + 1
    strBuffer = Space(lngLength)
    lngRet = GetWindowText(hWnd, strBuffer, lngLength)
    Window_Title = Left(strBuffer, lngLength - 1)

End Function


#If VBA7 Then
Private Function Window_ClassName(hWnd As LongPtr) As String
#Else
Private Function Window_ClassName(hWnd As Long) As String
#End If

    Dim strBuffer As String
    Dim lngRet As Long
    
    strBuffer = String$(256, Chr$(0))
    lngRet = GetClassName(hWnd, strBuffer, Len(strBuffer))
    Window_ClassName = Left$(strBuffer, lngRet)
    
End Function


#If VBA7 Then
Public Sub Show_Window(hWnd As LongPtr)
#Else
Public Sub Show_Window(hWnd As Long)
#End If

    SetForegroundWindow hWnd

End Sub


Public Sub PressKeys_Alt(keyCode As Byte)

    'Hold Alt down and press specified key
    keybd_event VK_MENU, 0, KEYEVENTF_KEYDOWN, 0
    keybd_event keyCode, 0, KEYEVENTF_KEYDOWN, 0
    keybd_event keyCode, 0, KEYEVENTF_KEYUP, 0
    keybd_event VK_MENU, 0, KEYEVENTF_KEYUP, 0
    
End Sub


Public Sub PressKeys_Ctrl(keyCode As Byte)

    'Hold Ctrl down and press specified key
    
    keybd_event VK_LCONTROL, 0, KEYEVENTF_KEYDOWN, 0
    keybd_event keyCode, 0, KEYEVENTF_KEYDOWN, 0
    keybd_event keyCode, 0, KEYEVENTF_KEYUP, 0
    keybd_event VK_LCONTROL, 0, KEYEVENTF_KEYUP, 0
    
End Sub


Public Sub PressKeys_Key(keyCode As Byte)

    keybd_event keyCode, 0, KEYEVENTF_KEYDOWN, 0
    keybd_event keyCode, 0, KEYEVENTF_KEYUP, 0
    
End Sub

Another option is using the Adobe REST API, where you send POST/GET requests to Adobe's PDF Services to first upload the PDF to Adobe's internal storage and then tell it to protect the PDF - https://developer.adobe.com/document-services/docs/apis/#tag/Protect-PDF. I haven't looked in detail at this method.

 

[John_w]

Another option is using the Adobe REST API, where you send POST/GET requests to Adobe's PDF Services to first upload the PDF to Adobe's internal storage and then tell it to protect the PDF - https://developer.adobe.com/document-services/docs/apis/#tag/Protect-PDF. I haven't looked in detail at this method.

See my thread: Create protected PDFs (with an Open password and/or a Permissions password) with Adobe PDF Services API

Adobe PDF Services is a free API and much easier to code than the UIAutomation code used in my previous reply.