TOP へ > Qpdf  > *

---

概要

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編)
　

引数

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

戻り値

無し。

関数 / サンプル

事前設定

1. コチラを参考にQpdf のダウンロードとインストールを行う。
2. Qpdf.exe のフルパスをCON_QPDF_PATHにセット。
3. 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 : http://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のセキュリティ

• Xpdf ：PDFのセキュリティ情報を取得するVBA関数
• Qpdf ：PDFのセキュリティ設定を取得するVBA関数 
• Qpdf ：PDFにセキュリティを設定するVBA関数
• Qpdf ：PDFのパスワードとセキュリティ設定を解除するVBA関数
• Qpdf ：PDFにパスワードとセキュリティ設定をコピーするVBA関数
  　   
• PDFのパスワードは３２文字まで
  　
• Acrobat / PDF 文書にパスワードを設定する方法 （Acrobat XI/DC）
• Acrobat / パスワードによる PDF の保護

＜　Qpdf へ戻る　＞