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

引数

  1. 第1引数:qpdfPara_EncryptPdfPath As String  (In)
    コピー元のPDFファイルのフルパス
  2. 第2引数:qpdfPara_EncryptPdfPassword As String  (In)
    コピー元のPDFファイルのユーザーパスワード。無ければ””。
  3. 第3引数:qpdfPara_InPdfPath As String  (In)
    入力のPDFファイルのフルパス
  4. 第4引数:qpdfPara_InPdfPassword As String  (In)
    入力のPDFファイルのユーザーパスワード。無ければ””。
  5. 第5引数:qpdfPara_OutPdfPath As String  (In)
    出力のPDFファイルのフルパス
  6. 第6引数:qpdfPara_OrverWrite As Boolean  (In)
    出力のPDFファイルが存在した時に上書きをするか?
    True:上書きをする
    False:上書きをしない
  7. 第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  ファイルで保存します。

DownloadcLine-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 ' 第1引数:qpdfPara_EncryptPdfPath As String (In) 088 ' パスワードとセキュリティ情報を持った 089 ' コピー元のPDFファイルのフルパス 090 ' 第2引数:qpdfPara_EncryptPdfPassword As String (In) 091 ' 第1引数ファイルのユーザーパスワード 092 ' コピー元のPDFファイルのフルパス 093 ' 第3引数:qpdfPara_InPdfPath As String (In) 094 ' 入力のPDFファイルのフルパス 095 ' 第4引数:qpdfPara_InPdfPassword As String (In) 096 ' 入力のPDFファイルのユーザーパスワード。無ければ""。 097 ' 第5引数:qpdfPara_OutPdfPath As String (In) 098 ' 出力のPDFファイルのフルパス 099 ' 第6引数:qpdfPara_OrverWrite As Boolean (In) 100 ' 出力のPDFファイルが存在した時に上書きをするか? 101 ' True:上書きをする 102 ' False:上書きをしない 103 ' 第7引数: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のセキュリティ

< Qpdf へ戻る >

コメントを残す

メールアドレスが公開されることはありません。 * が付いている欄は必須項目です

CAPTCHA


出来るだけ早く返答する様には心がけています。
が、遅くなる時もありますのでご了承ください。


SAMURAI Plugin

コメントをする時は出来れば以下もお願いします。

  • OS名 バージョン
  • Acrobat バージョン
  • ツール(Excel等) バージョン
コメントにサンプルコードを入れるとエラーになる場合が有ります。その時はコードの前後に <code> ・・・</code> タグを入れてください。

このサイトはスパムを低減するために Akismet を使っています。コメントデータの処理方法の詳細はこちらをご覧ください