Qpdf ： PDFのパスワードとセキュリティ設定を解除するVBA関数

TOP へ > Qpdf > *

概要

PDF のユーザーパスワードとオーナーパスワードを解除します。印刷、更新、抽出を許可しない等のセキュリティ設定も解除します。

ユーザーパスワードは事前に用意しておく必要があります。オーナーパスワードは知らなくても解除できます。オーナーパスワードを解除すると印刷、更新、抽出等のセキュリティ設定も同時に解除されます。

Acrobat OLE を使わずに Qpdf を使用して処理されます。

注記

解除は正当な理由の元で行う必要が有ります。

Qpdf とは

フリーソフト Qpdf を知らない人は先にコチラを御覧ください。

使用上の注意

当関数はQPDFの旧バージョンでの使用を想定しています。新バージョンのQPDFで追加された新オプションを使用すると、エラー扱いになるので、その部分は各自で手修正してご利用下さい。

形式

001 Public Sub qpdfRemoveEncryption( _
002     ByVal qpdfPara_InPdfPath As String, _
003     ByVal qpdfPara_InPdfPassword As String, _
004     ByVal qpdfPara_OutPdfPath As String, _
005     ByVal qpdfPara_OrverWrite As Boolean, _
006     ByRef strErr As String)

　Highlight：プログラミング言語のソースコードを構文で色分け (GUI編)
　

引数

第１引数：qpdfPara_InPdfPath As String (In)
入力のPDFファイルのフルパス
第２引数：qpdfPara_InPdfPassword As String (In)
入力のPDFファイルのユーザーパスワード。無ければ””。
第３引数：qpdfPara_OutPdfPath As String (In)
出力のPDFファイルのフルパス
第４引数：qpdfPara_OrverWrite As Boolean (In)
出力のPDFファイルが存在した時に上書きをするか？
True：上書きをする
False：上書きをしない
第５引数：strErr As String (Out)
エラーメッセージ。エラー無しは””

戻り値

無し。

関数 / サンプル

事前設定

コチラを参考にQpdf のダウンロードとインストールを行う
Qpdf.exe のフルパスをCON_QPDF_PATHにセット。
gDebugMode = True　のデバッグモードをFalseにセット。

サンプル

test-ps2u.pdf のユーザーパスワード「abc」を解除します。印刷等のセキュリティ設定も解除します。解除した結果はPS-3Du.pdf ファイルで出力します。

Download：cLine-qpdfRemoveEncryption.xls

001 Option Explicit
002  
003 Declare Function WaitForSingleObject Lib "kernel32" _
004     (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
005 Declare Function CloseHandle Lib "kernel32" _
006     (ByVal hObject As Long) As Long
007 Declare Function GetExitCodeProcess Lib "kernel32" _
008     (ByVal hProcess As Long, lpExitCode As Long) As Long
009 Declare Function OpenProcess Lib "kernel32" _
010     (ByVal dwDesiredAccess As Long, _
011     ByVal bInheritHandle As Long, _
012     ByVal dwProcessID As Long) As Long
013 Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
014  
015 Const SYNCHRONIZE = 1048576
016 Const PROCESS_QUERY_INFORMATION = &H400
017  
018 'Qpdf-6.00 qpdf.exe
019 Const CON_QPDF_PATH = "I:¥Tools¥Run¥Qpdf-6.0.0¥bin¥qpdf.exe"
020 '   Teme File No
021 Private gFileCnt    As Long
022 '   Debug Mode [ True=On | False=Off ]
023 Private gDebugMode  As Boolean
024  
025 '   テスト用呼び出し
026 Sub Main_Demo()
027     gDebugMode = True   '実運用ではFalse
028     
029     Dim qpdfPara_InPdfPath      As String
030     Dim qpdfPara_InPdfPassword  As String
031     Dim qpdfPara_OutPdfPath     As String
032     Dim qpdfPara_OrverWrite     As Boolean
033     Dim strErr                  As String
034     
035     If gDebugMode Then Debug.Print "Start:" & Now
036 '    Dim j   As Long
037 '    For j = 0 To ****
038     
039     '入力PDFのフルパス
040     qpdfPara_InPdfPath = Application.ActiveWorkbook.Path & _
041         "¥" & "test-ps2u.pdf"
042     '入力PDFの(文書を開く時の)ユーザーパスワード
043     qpdfPara_InPdfPassword = "abc"
044     '出力PDFのフルパス
045     qpdfPara_OutPdfPath = Application.ActiveWorkbook.Path & _
046         "¥" & "PS-3Du.pdf"
047     
048     '出力時は上書きするか？
049     '   Falseは上書きしない=エラーになる
050     qpdfPara_OrverWrite = True
051     
052     strErr = ""
053     Call qpdfRemoveEncryption(qpdfPara_InPdfPath, _
054         qpdfPara_InPdfPassword, qpdfPara_OutPdfPath, _
055         qpdfPara_OrverWrite, strErr)
056     
057     If strErr <> "" Then
058         MsgBox strErr, vbCritical, "実行エラー"
059         Exit Sub
060     End If
061  
062 '    Next j
063     If gDebugMode Then Debug.Print "End  :" & Now
064     
065     MsgBox "End"
066 End Sub
067  
068 '**************************************************
069 '
070 ' Remove any encryption on the PDF file.
071 '
072 ' 機能    : qpdf.exe で
073 '           パスワードとセキュリティ設定を解除する｡
074 ' Create  : 2016/06/28
075 ' Update  : 2016/06/28
076 ' Vertion : 1.0.0
077 '
078 ' 第１引数：qpdfPara_InPdfPath As String  (In)
079 '           入力のPDFファイルのフルパス
080 ' 第２引数：qpdfPara_InPdfPassword As String  (In)
081 '           入力のPDFファイルのユーザーパスワード。無ければ""。
082 ' 第３引数：qpdfPara_OutPdfPath As String  (In)
083 '           出力のPDFファイルのフルパス
084 ' 第４引数：qpdfPara_OrverWrite As Boolean  (In)
085 '           出力のPDFファイルが存在した時に上書きをするか？
086 '           True：上書きをする
087 '           False：上書きをしない
088 ' 第５引数：strErr As String  (Out)
089 '           エラーメッセージ: エラー無しは ""
090  
091 ' 戻り値  : 無し
092 '
093 ' 備考    : strErr<>""の時はエラー扱いとする。
094 ' URL     : https://pdf-file.nnn2.com/?p=868
095 ' その他  : 著作権等は主張しません。
096 '           上記URLにコメントを頂けると嬉しいです。
097 '
098 '**************************************************
099  
100 Public Sub qpdfRemoveEncryption( _
101     ByVal qpdfPara_InPdfPath As String, _
102     ByVal qpdfPara_InPdfPassword As String, _
103     ByVal qpdfPara_OutPdfPath As String, _
104     ByVal qpdfPara_OrverWrite As Boolean, _
105     ByRef strErr As String)
106     
107 On Error GoTo Err_qpdfRemoveEncryption:
108     
109     Dim strTempFilePath     As String
110     Dim strCmd              As String
111     Dim objFileSystem       As Object
112     
113     '初期化
114     Set objFileSystem = CreateObject("Scripting.FileSystemObject")
115     strErr = ""
116     
117     'エラーチェック
118     If objFileSystem.FileExists(qpdfPara_InPdfPath) = False Then
119         strErr = qpdfPara_InPdfPath & vbCrLf & _
120             "このファイルは存在しません"
121         Exit Sub
122     End If
123     If objFileSystem.FileExists(qpdfPara_OutPdfPath) = True Then
124         If qpdfPara_OrverWrite = False Then
125             strErr = qpdfPara_OutPdfPath & vbCrLf & _
126                 "このファイルは存在します"
127             Exit Sub
128         End If
129     End If
130     If objFileSystem.FileExists(CON_QPDF_PATH) = False Then
131         strErr = CON_QPDF_PATH & vbCrLf & _
132             "このファイルは存在しません"
133         Exit Sub
134     End If
135     
136     'コマンドラインの編集
137     strCmd = CON_QPDF_PATH & " --decrypt "
138     
139     If qpdfPara_InPdfPassword <> "" Then
140         strCmd = strCmd & "--password=" & _
141             qpdfPara_InPdfPassword & " "
142     End If
143     
144     '一時ファイル
145     gFileCnt = gFileCnt + 1
146     strTempFilePath = Application.ActiveWorkbook.Path & _
147         "¥" & Format(Now(), "yyyymmdd-hhmmss-") & gFileCnt & ".txt"
148     
149     '注意：ファイルパスの前後にシングルクォーテーション"を入れる
150     strCmd = strCmd & _
151         """" & qpdfPara_InPdfPath & _
152         """ """ & qpdfPara_OutPdfPath & _
153         """ > """ & strTempFilePath & """ 2>&1"
154     
155     'コマンドラインの実行
156     strCmd = "cmd /c " & strCmd
157     Call RunCommandLine(strCmd, strErr)
158     If gDebugMode Then Debug.Print strCmd
159     
160 On Error GoTo Skip:
161     '標準出力のテキストを読み込む
162     Dim strInput        As String
163     Dim lFileNo         As Long
164     lFileNo = FreeFile
165     Open strTempFilePath For Input As #lFileNo
166     Do Until EOF(lFileNo)
167         Line Input #lFileNo, strInput
168         strErr = strErr & vbCrLf & Trim(strInput)
169     Loop
170     Close #lFileNo
171     
172     '一時ファイルの削除
173     If Trim$(strErr) = "" Then Kill strTempFilePath
174 Skip:
175     Set objFileSystem = Nothing
176     Exit Sub
177 Err_qpdfRemoveEncryption:
178     strErr = "(qpdfRemoveEncryption) Runtime Error :" & _
179         Err.Number & vbCrLf & Err.Description
180 End Sub
181  
182 '   shell 関数の終了を待つ
183  
184 Sub RunCommandLine(ByVal strCmd As String, _
185                    ByRef strErr As String)
186 On Error GoTo Err_RunCommandLine:
187     
188     Dim hProcess        As Long
189     Dim lpdwExitCode    As Long
190     Dim dwProcessID     As Long
191     Dim retVal          As Long
192     Dim lCnt            As Long
193     Const CON_SLEEP = 20
194     Const CON_LOOP_CNT = 250
195     lCnt = 0
196     dwProcessID = Shell(strCmd, vbHide)
197     hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, _
198         True, dwProcessID)
199     Do
200         Sleep CON_SLEEP
201         DoEvents
202         retVal = GetExitCodeProcess(hProcess, lpdwExitCode)
203         lCnt = lCnt + 1
204         If lCnt > CON_LOOP_CNT Then
205             If gDebugMode Then Debug.Print vbCrLf & strCmd
206             strErr = "Shell Error : Time Orver " & _
207                 CON_SLEEP * CON_LOOP_CNT & "ms"
208             Exit Sub
209         End If
210         'shell関数で実行したアプリが終了するまでループ
211     Loop While lpdwExitCode <> 0
212     Exit Sub
213 Err_RunCommandLine:
214     strErr = "(RunCommandLine) Runtime Error :" & _
215         Err.Number & vbCrLf & Err.Description
216 End Sub

　Highlight：プログラミング言語のソースコードを構文で色分け (GUI編)
　

結果

▽実行前

▽実行後

▽ユーザーパスワードを間違った時に表示されるエラーメッセージ

・１行目はVBA関数からのメッセージ
・２行目からは Qpdf.exe からのエラーメッセージ

備考

VBAのShell 関数の第一引数の文字数に制限が有るみたいだが、255文字で無いことは確かです。それよりも大きい数値でもOKです。
VBAのDir 関数でもファイルの存在チックが出来ますがパス長が256文字以上に未対応です。そこで "Scripting.FileSystemObject" のFileExists を使ってファイルの存在チェックを行います。Dir 関数は使わない方がいいです。

PDFのセキュリティ

< Qpdf へ戻る >

PDF