PDA

View Full Version : Generate / Create PDF using VBA and Password protect PDF



excelliot
11-27-2010, 08:03 AM
Hi,

Is there any way through which with the help of excel VBA I can Generate / Create PDF also Password protect the same.

Thanks in advance. :banghead: :dunno

Bob Phillips
11-27-2010, 09:59 AM
What version of Excel?

excelliot
11-27-2010, 10:46 AM
Excel 2003 & 2007, if it works on both then OK, else any one will do.

Bob Phillips
11-27-2010, 11:26 AM
In Excel 2007, there is a built in PDF saveas.

Look at ExportAsFixedFormat in VBA help.

excelliot
11-28-2010, 12:02 AM
I read that, but how to password generated document.

excelliot
11-29-2010, 05:10 AM
Any Solutions

Kenneth Hobs
11-29-2010, 07:36 AM
I would do it in two steps. 1. Create the pdf. 2. Shell() to a 3rd party program to add the password.

For 1:
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:="X:\Book1.pdf", _
Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=False

For 2:
Using pdftk at: http://www.pdflabs.com/docs/install-pdftk/
I have not tested this but the vba command might be something like:
Shell ("u:\Material\Utility\pdftk\pdftk.exe X:\Book1.pdf owner_pw Hobs user_pw ken output X:\Book1_Secure.pdf")


Try doing it at a DOS prompt or Start > Run, first to get your syntax for the Shell() command right.

solomraj
05-31-2016, 05:06 AM
Hi ,
Protection of PDF using VBA is possible in 2 ways
1. We can protect the existing PDF which is already there
2. We can create PDF using excel and then Protect
You need adobe professional version to be installed. You have to create SecuritySettings Object, ConversionSettings Object and PDFMakerApp object.
Using the 3 object linked to each other we can lock the pdf. If you would like to know more details please email me solomraj which is my gmail account
Thanks and Regards
Raj Mohan

gmayor
05-31-2016, 06:45 AM
If you are happy to install the Open Source product PDF Creator (I prefer version 1.7.3 (http://www.npackd.org/p/org.pdfforge.PDFCreator/1.7.3)to the more bloated later version) then creating protected PDFs is simply a matter of printing to the driver. This is VBA compatible and you could use the following function to switch to the PDF driver create the PDF then switch back to the original printer. The function to set the printer driver is credited with its creator.

The test macro demonstrates how to call the procedure and saves the declared range to a PDF named from cell A1 in the active sheet.

The Master password is 'Master' and the User password is 'User'. Obviously these can be changed. The code also allows the copy, print and edit options to be set.

If installing PDFCreator, install only the basic PDFCreator program and not all the junk that comes with it ... unless you really want the junk. :)


Option Explicit

Sub Test()
ActiveSheet.PageSetup.PrintArea = "$A$1:$G$24"
'the area to be printed to PDF
PrintToPDFCreator Range("A1") & ".pdf", "C:\Path\", ActiveWorkbook, "Master", "User", True, True, True
End Sub


Sub PrintToPDFCreator(sPDFName As String, _
sPDFPath As String, _
xlBook As Workbook, _
Optional sMasterPass As String, _
Optional sUserPass As String, _
Optional bNoCopy As Boolean, _
Optional bNoPrint As Boolean, _
Optional bNoEdit As Boolean)
'Graham Mayor - www.gmayor.com
Dim pdfjob As Object
Dim sPrinter As String
Dim sDefaultPrinter As String
Dim iCopy As Integer, iPrint As Integer, iEdit As Integer

If bNoCopy Then iCopy = 1 Else iCopy = 0
If bNoPrint Then iPrint = 1 Else iPrint = 0
If bNoEdit Then iEdit = 1 Else iEdit = 0

sDefaultPrinter = Application.ActivePrinter ' store default printer
sPrinter = GetPrinterFullName("PDFCreator")
If sPrinter = vbNullString Then ' no match
MsgBox "PDFCreator Not Available"
GoTo lbl_Exit
Else
Application.ActivePrinter = sPrinter

Set pdfjob = CreateObject("PDFCreator.clsPDFCreator")

With pdfjob
If .cStart("/NoProcessingAtStartup") = False Then
GoTo err_handler
End If

.cStart "/NoProcessingAtStartup"
.cOption("UseAutosave") = 1
.cOption("UseAutosaveDirectory") = 1
.cOption("AutosaveDirectory") = sPDFPath
.cOption("AutosaveFilename") = sPDFName
.cOption("AutosaveFormat") = 0 ' 0 = PDF

If Not sMasterPass = vbNullString Then

'The following are required to set security of any kind
.cOption("PDFUseSecurity") = 1
.cOption("PDFOwnerPass") = 1
.cOption("PDFOwnerPasswordString") = sMasterPass

'To set individual security options
.cOption("PDFDisallowCopy") = iCopy
.cOption("PDFDisallowModifyContents") = iEdit
.cOption("PDFDisallowPrinting") = iPrint

'To force a user to enter a password before opening
.cOption("PDFUserPass") = 1
.cOption("PDFUserPasswordString") = sUserPass
'To change to High encryption
.cOption("PDFHighEncryption") = 1
End If

.cClearCache
End With

'Print the workbook to PDF
xlBook.PrintOut

'Wait until the print job has entered the print queue
Do Until pdfjob.cCountOfPrintjobs = 1
DoEvents
Loop
pdfjob.cPrinterStop = False

'Wait until PDF creator is finished then release the objects
Do Until pdfjob.cCountOfPrintjobs = 0
DoEvents
Loop
pdfjob.cClose
Application.ActivePrinter = sDefaultPrinter ' restore default printer
End If
lbl_Exit:
Set pdfjob = Nothing
Exit Sub
err_handler:
MsgBox "Unable to initialize PDFCreator." & vbCr & vbCr & _
"This may be an indication that the PDF application has become corrupted, " & _
"or its spooler blocked by AV software." & vbCr & vbCr & _
"Re-installing PDF Creator may restore normal working."
Err.Clear
GoTo lbl_Exit
End Sub

Private Function GetPrinterFullName(Printer As String) As String

' This function returns the full name of the first printerdevice that matches Printer.
' Full name is like "PDFCreator on Ne01:" for a English Windows and like
' "PDFCreator sur Ne01:" for French.
' Created: Frans Bus, 2015. See http://pixcels.nl/set-activeprinter-excel
' see http://blogs.msdn.com/b/alejacma/archive/2008/04/11/how-to-read-a-registry-key-and-its-values.aspx
' see http://www.experts-exchange.com/Software/Microsoft_Applications/Q_27566782.html

Const HKEY_CURRENT_USER = &H80000001
Dim regobj As Object
Dim aTypes As Variant
Dim aDevices As Variant
Dim vDevice As Variant
Dim sValue As String
Dim v As Variant
Dim sLocaleOn As String

' get locale "on" from current activeprinter
v = Split(Application.ActivePrinter, Space(1))
sLocaleOn = Space(1) & CStr(v(UBound(v) - 1)) & Space(1)

' connect to WMI registry provider on current machine with current user
Set regobj = GetObject("WINMGMTS:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")

' get the Devices from the registry
regobj.EnumValues HKEY_CURRENT_USER, "Software\Microsoft\Windows NT\CurrentVersion\Devices", aDevices, aTypes

' find Printer and create full name
For Each vDevice In aDevices
' get port of device
regobj.GetStringValue HKEY_CURRENT_USER, "Software\Microsoft\Windows NT\CurrentVersion\Devices", vDevice, sValue
' select device
If Left(vDevice, Len(Printer)) = Printer Then ' match!
' create localized printername
GetPrinterFullName = vDevice & sLocaleOn & Split(sValue, ",")(1)
Exit Function
End If
Next
lbl_Exit:
' at this point no match found
GetPrinterFullName = vbNullString
Exit Function
End Function