Save as PDF (With Password)

[bitpusher]

I need some VB6/VBA code to ole automate MS Word (2007 and up). I need to open a rtf file and save as PDF be able to password protect the PDF file. Is this even possible? Thank you for any assistance.

[macropod]

Creating PDFs via the ExportAsFixedFormat and SaveAs2 methods is possible, but I don't believe either of these allows you to password protect the PDF file.

[newbie101]

It's possible using a third party pdf printer driver. My favorite is bullzip (http://www.bullzip.com/products/pdf/info.php).

See http://www.bullzip.com/products/pdf2/doc/info.php

[fumei]

Interesting newbie101. Thanks for the link. Although with admitedly only a quick look, it appears though that bullip is not exposed to VBA. So unless your VBA is writing to the ini files or the Registry - both possible - it is not really applicable to the original question.

[newbie101]

Here is some sample code that I have used in the past (not related directly to the original question, because no password is set)
Option Explicit

Public Declare Function SetDefaultPrinter Lib "winspool.drv" _
Alias "SetDefaultPrinterA" (ByVal pszPrinter As String) As Long

'Uses early binding so you must add a reference to BullZip

Function PrintReportAsPDFwithBullZip(ByVal rptName As String, _
Optional sFilterCriteria As String = "", _
Optional sDirectory As String = "", _
Optional sFileName As String = "") _
As Boolean

On Error GoTo err_Error

Dim clsPDF As New Bullzip.PDFPrinterSettings 'Initialize the PDF class
Dim strSavePath As String, strFileName As String

Dim strDefaultPrinter As String
Dim blnPrinterChanged As Boolean

'set the success flag to true here but it will be set to
'false if the function fails at any point
PrintReportAsPDFwithBullZip = True

If sDirectory = "" Then
sDirectory = GetSpecialFolder(CSIDL_LOCAL_APPDATA) & "\" & FileNameNoExt(GetDBName) & "\"
Else
sDirectory = sDirectory
End If

If sFileName = "" Then
sFileName = FileNameNoExt(GetDBName)
Else
sFileName = sFileName
End If

' strSavePath = GetSpecialFolder(CSIDL_LOCAL_APPDATA) & "\MyDir\"
' strFileName = "MyFile" - " & Format(Date, "mm.dd.yyyy") & ".pdf" 'InputBox("Save PDF to desktop as:")
If LCase(Right(sFileName, 4)) <> ".pdf" Then
sFileName = sFileName & ".pdf"
End If

With clsPDF
.Init
.SetValue "Output", sDirectory & sFileName
.SetValue "ShowSettings", "never"
.SetValue "ShowPDF", "no"
.SetValue "ConfirmOverwrite", "no"
.SetValue "SuppressErrors", "yes"
.SetValue "ShowProgress", "no"
.SetValue "ShowProgressFinished", "no"
.SetValue "Author", "Me"
.SetValue "Title", "MyFile"
.SetValue "Subject", "MySubject"
.WriteSettings (True) 'writes the settings in a runonce.ini that is immediately deleted after being used.
End With

If InStr(Application.Printer.DeviceName, "BullZip") = 0 Then ' If BullZip isn't the default printer
blnPrinterChanged = True ' Set the printer changed flag to true
strDefaultPrinter = Application.Printer.DeviceName ' Save name of current printer
SetDefaultPrinter "Bullzip PDF Printer" ' Use API to set the Current printer to Bullzip
End If

DoEvents
' fncScreenUpdating State:=False 'Freeze screen updating
DoCmd.OpenReport rptName, acViewNormal, , sFilterCriteria
' fncScreenUpdating State:=True 'Unfreeze screen updating
DoEvents

If blnPrinterChanged Then SetDefaultPrinter strDefaultPrinter

'error handler and exit
err_Exit:
Set clsPDF = Nothing
Exit Function
err_Error:
PrintReportAsPDFwithBullZip = False
MsgBox Err.Description
Resume err_Exit
Resume

End Function

[fumei]

and there you go

"early binding so you must add a reference to BullZip"

[newbie101]

You could of course use late binding (not that I have tell you that, but it may be useful for the op).

Dim myobject As Object
Set myobject = CreateObject("Bullzip.PDFPrinterSettings")

[fumei]

I suspect you are not all that much of a newbie...

[newbie101]

All things are relative, I haven't retired yet;)