Qpdf ： PDFにパスワードとセキュリティ設定をコピーするVBA関数

TOP へ > Qpdf > *

CJTF-HOA veterinary experts team with Uganda to treat 30,000 animals [Image 9 of 16]

概要

PDFのユーザーパスワード、オーナーパスワードとセキュリティ設定の情報のみを別のPDFへコピーするVBA関数です。コピー後は別名で保存されます。

コピーを受け取るPDFのユーザーパスワードとオーナーパスワードのセキュリティ設定の情報は全て上書きされて残りません。また元のPDFへの上書き保存はできません。

Acrobat OLE を使わずに Qpdf を使用して行います。

注記

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

Qpdf とは

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

使用上の注意

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

形式

001 Public Sub qpdfCopyEncryption( _
002     ByVal qpdfPara_EncryptPdfPath As String, _
003     ByVal qpdfPara_EncryptPdfPassword As String, _
004     ByVal qpdfPara_InPdfPath As String, _
005     ByVal qpdfPara_InPdfPassword As String, _
006     ByVal qpdfPara_OutPdfPath As String, _
007     ByVal qpdfPara_OrverWrite As Boolean, _
008     ByRef strErr As String)

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

引数

第１引数：qpdfPara_EncryptPdfPath As String (In)
コピー元のPDFファイルのフルパス
第２引数：qpdfPara_EncryptPdfPassword As String (In)
コピー元のPDFファイルのユーザーパスワード。無ければ””。
第３引数：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にセット。

サンプル

ユーザーパスワード「cp3u」のcopy3.pdf からユーザーパスワードとオーナーパスワードのセキュリティ情報を抜き出します。その情報を in1.pdf のユーザーパスワードとオーナーパスワードの情報に上書きします。結果はcopy3-in1.pdf ファイルで保存します。

Download：cLine-qpdfCopyEncryption.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_EncryptPdfPath As String
030     Dim qpdfPara_EncryptPdfPassword As String
031     Dim qpdfPara_InPdfPath      As String
032     Dim qpdfPara_InPdfPassword  As String
033     Dim qpdfPara_OutPdfPath     As String
034     Dim qpdfPara_OrverWrite     As Boolean
035     Dim strErr                  As String
036     
037     If gDebugMode Then Debug.Print "Start:" & Now
038 '    Dim j   As Long
039 '    For j = 0 To ****
040     
041     'パスワードとセキュリティ情報を持ったPDFのフルパス
042     qpdfPara_EncryptPdfPath = Application.ActiveWorkbook.Path & _
043         "¥" & "copy3.pdf"
044     '上記のユーザーパスワード
045     qpdfPara_EncryptPdfPassword = "cp3u"
046     '入力PDFのフルパス
047     qpdfPara_InPdfPath = Application.ActiveWorkbook.Path & _
048         "¥" & "in1.pdf"
049     '入力PDFの(文書を開く時の)ユーザーパスワード
050     qpdfPara_InPdfPassword = ""
051     '出力PDFのフルパス
052     qpdfPara_OutPdfPath = Application.ActiveWorkbook.Path & _
053         "¥" & "copy3-in1.pdf"
054     
055     '出力時は上書きするか？
056     '   Falseは上書きしない=エラーになる
057     qpdfPara_OrverWrite = True
058     
059     strErr = ""
060     Call qpdfCopyEncryption(qpdfPara_EncryptPdfPath, _
061         qpdfPara_EncryptPdfPassword, qpdfPara_InPdfPath, _
062         qpdfPara_InPdfPassword, qpdfPara_OutPdfPath, _
063         qpdfPara_OrverWrite, strErr)
064     
065     If strErr <> "" Then
066         MsgBox strErr, vbCritical, "実行エラー"
067         Exit Sub
068     End If
069  
070 '    Next j
071     If gDebugMode Then Debug.Print "End  :" & Now
072     
073     MsgBox "End"
074 End Sub
075  
076 '**************************************************
077 '
078 ' Copy any encryption parameters from the PDF file.
079 '
080 ' 機能    : qpdf.exeを使ってパスワードとセキュリティ設定を
081 '           別のPDFへコピーします｡
082 '
083 ' Create  : 2016/06/28
084 ' Update  : 2017/09/13
085 ' Vertion : 1.0.1
086 '
087 ' 第１引数：qpdfPara_EncryptPdfPath As String  (In)
088 '           パスワードとセキュリティ情報を持った
089 '           コピー元のPDFファイルのフルパス
090 ' 第２引数：qpdfPara_EncryptPdfPassword As String  (In)
091 '  第１引数ファイルのユーザーパスワード
092 '           コピー元のPDFファイルのフルパス
093 ' 第３引数：qpdfPara_InPdfPath As String  (In)
094 '           入力のPDFファイルのフルパス
095 ' 第４引数：qpdfPara_InPdfPassword As String  (In)
096 '           入力のPDFファイルのユーザーパスワード。無ければ""。
097 ' 第５引数：qpdfPara_OutPdfPath As String  (In)
098 '           出力のPDFファイルのフルパス
099 ' 第６引数：qpdfPara_OrverWrite As Boolean  (In)
100 '           出力のPDFファイルが存在した時に上書きをするか？
101 '           True：上書きをする
102 '           False：上書きをしない
103 ' 第７引数：strErr As String  (Out)
104 '           エラーメッセージ: エラー無しは ""
105  
106 ' 戻り値  : 無し
107 '
108 ' 備考    : strErr<>""の時はエラー扱いとする。
109 ' URL     : https://pdf-file.nnn2.com/?p=869
110 ' その他  : 著作権等は主張しません。
111 '           上記URLにコメントを頂けると嬉しいです。
112 '
113 '**************************************************
114  
115 Public Sub qpdfCopyEncryption( _
116     ByVal qpdfPara_EncryptPdfPath As String, _
117     ByVal qpdfPara_EncryptPdfPassword As String, _
118     ByVal qpdfPara_InPdfPath As String, _
119     ByVal qpdfPara_InPdfPassword As String, _
120     ByVal qpdfPara_OutPdfPath As String, _
121     ByVal qpdfPara_OrverWrite As Boolean, _
122     ByRef strErr As String)
123     
124 On Error GoTo Err_qpdfCopyEncryption:
125     
126     Dim strTempFilePath     As String
127     Dim strCmd              As String
128     Dim objFileSystem       As Object
129     
130     '初期化
131     Set objFileSystem = CreateObject("Scripting.FileSystemObject")
132     strErr = ""
133     
134     'エラーチェック
135     If objFileSystem.FileExists(qpdfPara_EncryptPdfPath) = False Then
136         strErr = qpdfPara_EncryptPdfPath & vbCrLf & _
137             "このファイルは存在しません"
138         Exit Sub
139     End If
140     If objFileSystem.FileExists(qpdfPara_InPdfPath) = False Then
141         strErr = qpdfPara_InPdfPath & vbCrLf & _
142             "このファイルは存在しません"
143         Exit Sub
144     End If
145     If objFileSystem.FileExists(qpdfPara_OutPdfPath) = True Then
146         If qpdfPara_OrverWrite = False Then
147             strErr = qpdfPara_OutPdfPath & vbCrLf & _
148                 "このファイルは存在します"
149             Exit Sub
150         End If
151     End If
152     If objFileSystem.FileExists(CON_QPDF_PATH) = False Then
153         strErr = CON_QPDF_PATH & vbCrLf & _
154             "このファイルは存在しません"
155         Exit Sub
156     End If
157     
158     'コマンドラインの編集
159     strCmd = CON_QPDF_PATH & " --copy-encryption=""" & _
160         qpdfPara_EncryptPdfPath & """ "
161     
162     If qpdfPara_EncryptPdfPassword <> "" Then
163         strCmd = strCmd & "--encryption-file-password=" & _
164             qpdfPara_EncryptPdfPassword & " "
165     End If
166     
167     If qpdfPara_InPdfPassword <> "" Then
168         strCmd = strCmd & "--password=" & _
169             qpdfPara_InPdfPassword & " "
170     End If
171     
172     '一時ファイル
173     gFileCnt = gFileCnt + 1
174     strTempFilePath = Application.ActiveWorkbook.Path & _
175         "¥" & Format(Now(), "yyyymmdd-hhmmss-") & gFileCnt & ".txt"
176     
177     '注意：ファイルパスの前後にシングルクォーテーション"を入れる
178     strCmd = strCmd & _
179         """" & qpdfPara_InPdfPath & _
180         """ """ & qpdfPara_OutPdfPath & _
181         """ > """ & strTempFilePath & """ 2>&1"
182     
183     'コマンドラインの実行
184     strCmd = "cmd /c " & strCmd
185     Call RunCommandLine(strCmd, strErr)
186     If gDebugMode Then Debug.Print strCmd
187     
188 On Error GoTo Skip:
189     '標準出力のテキストを読み込む
190     Dim strInput        As String
191     Dim lFileNo         As Long
192     lFileNo = FreeFile
193     Open strTempFilePath For Input As #lFileNo
194     Do Until EOF(lFileNo)
195         Line Input #lFileNo, strInput
196         strErr = strErr & vbCrLf & Trim(strInput)
197     Loop
198     Close #lFileNo
199     
200     '一時ファイルの削除
201     If Trim$(strErr) = "" Then Kill strTempFilePath
202 Skip:
203     Set objFileSystem = Nothing
204     Exit Sub
205  
206 Err_qpdfCopyEncryption:
207     strErr = "(qpdfCopyEncryption) Runtime Error :" & _
208         Err.Number & vbCrLf & Err.Description
209 End Sub
210  
211  
212 '**************************************************
213 '
214 '   shell 関数の終了を待つ
215 '
216 '**************************************************
217  
218 Sub RunCommandLine(ByVal strCmd As String, _
219                    ByRef strErr As String)
220 On Error GoTo Err_RunCommandLine:
221     
222     Dim hProcess        As Long
223     Dim lpdwExitCode    As Long
224     Dim dwProcessID     As Long
225     Dim retVal          As Long
226     Dim lCnt            As Long
227     Const CON_SLEEP = 20
228     Const CON_LOOP_CNT = 250
229     lCnt = 0
230     dwProcessID = Shell(strCmd, vbHide)
231     hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, _
232         True, dwProcessID)
233     Do
234         Sleep CON_SLEEP
235         DoEvents
236         retVal = GetExitCodeProcess(hProcess, lpdwExitCode)
237         lCnt = lCnt + 1
238         If lCnt > CON_LOOP_CNT Then
239             If gDebugMode Then Debug.Print vbCrLf & strCmd
240             strErr = "Shell Error : Time Orver " & _
241                 CON_SLEEP * CON_LOOP_CNT & "ms"
242             Exit Sub
243         End If
244         'shell関数で実行したアプリが終了するまでループ
245     Loop While lpdwExitCode <> 0
246     Exit Sub
247 Err_RunCommandLine:
248     strErr = "(RunCommandLine) Runtime Error :" & _
249         Err.Number & vbCrLf & Err.Description
250 End Sub

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

備考

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

PDFのセキュリティ

＜　Qpdf へ戻る　＞

PDF