関数:PDFの文書プロパティ(概要)を更新

TOP > サンプル/関数 > 関数:PDFの文書プロパティ(概要)を更新      [...]


Pixfav-Images You Love to View

概要

SetInfo メソッドでは完全にPDFのプロパティを更新できない時に使用する関数です。PDFファイル内のメタデータ(XMP)と文書情報ディクショナリー(Info)に有る以下の項目を更新します。

  • タイトル
  • サブタイトル
  • 作成者
  • キーワード ※上書きします。
  • 著作権情報
関数:PDFの文書プロパティを更新
関数:PDFの文書プロパティを更新

機能

  1. 入力PDFから不要なオブジェクト類を消す為に最初に最適化します。
  2. 文書情報ディクショナリー(Info)情報を更新します。
  3. メタデータ(XMP)を取り出して更新します。
  4. 結果を出力PDFへ最適化して保存します。
  5. CON_DEBUG = True の時は各処理内容の詳細なログをテキストファイルへ出力します。

注意事項

  1. キーワードに関して、当関数は上書きします。
  2. SetInfo メソッドGetInfoメソッド、Acrobatのプロパティ画面、Acrobatのプロパティの詳細(XMP)画面との内容はそれぞれ異なる場合が有ります。当関数では全ての結果が同じになるように処理をします。
    ※但し、次の「3.」の場合の注意点は回避出来ませんでした。
  3. 当関数では、作成者を2つ以上登録しようとしてもInfoデータ(GetInfo の結果)には1番目しか登録されません。
  4. 作成者、キーワードの文字列に小文字のカンマ「,」とセミコロン「;」は使用できません。区切り文字として判断されてしまう為です。
    どうしても使用したい時は文字列の前後をダブルクオーテーションで囲ってください。※CSVデータの扱いと同じみたいです。
    但しダブルクオーテーションを使うと予期せぬ結果になる場合があります。その場合はカンマとセミコロンを全角に変更してなどして判断してください。
  5. メタデータ(XMP)と文書情報ディクショナリー(Info)の扱い方に疑問が有ります。AcrobatのOLEの動作に一部理解できない部分が有ります。よって必ず事前に動作確認をしてから、ご使用ください。
  6. 関数を動作させる前に CON_WORK_FOLDER 定数に作業フォルダを事前に指定する必要が有ります。指定方法はサンプル参照。

形式

001 [boolean] = PDF_Update_MXP_INFO ( _ 002   String sInputPdf , _ 003   String sOutputPDF , _ 004   String sTitle , _ 005   String sSubject , _ 006   String sAuthor( ) , _ 007   String sKeywords( ) , _ 008   String sRights , _ 009   String sMessage )


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

引数

  1. 第一引数 ( string  sInputPdf ) :
    入力PDF ファイルのフルパス
  2. 第二引数 ( string  sOutputPDF ) :
    出力PDF ファイルのフルパス
  3. 第三引数 ( string  sTitle ) :
    文書プロパティのタイトル
  4. 第四引数 ( string  sSubject ) :
    文書プロパティのサブタイトル
  5. 第五引数 ( string  sAuthor( )  ) :
    文書プロパティの作成者
    配列で複数指定可能。但し注意有り。
  6. 第六引数 ( string  sKeywords( ) ) :
    文書プロパティのキーワード
    配列で複数指定可能
  7. 第七引数 ( string  sRights ) :
    文書プロパティの著作権情報
  8. 第八引数 ( string  sMessage ) :
    関数内でエラー時のみにセットされるエラーメッセージ
  • 「タイトル」、「サブタイトル」、「作成者」、「キーワード」、「著作権情報」を処理したくない時は vbNullChar をセットします。0バイト文字 ”” の時は該当の文書プロパティを空にします。詳細はサンプルを参照してください。

戻り値

  1. True : 正常終了。
  2. False : エラー有り。第八引数に詳細なエラーメッセージがセットされます。

サンプル

  1. Test1.PDF の「タイトル」、「サブタイトル」、「作成者」、「キーワード」、「著作権情報」を更新し、Test1-OUT1.PDFで出力します。
    • タイトル: "■①タイトル"
    • サブタイトル: "■②サブタイトル"
    • 作成者の1番目: "■③作成者1"
    • 作成者の2番目: "■③作成者2"
    • キーワードの1番目: "■④キーワード1"
    • キーワードの2番目: "■④キーワード2"
    • 著作権情報: "■⑤著作権情報"
  2. 作業フォルダは "D:¥Temp¥Log¥" です。CON_WORK_FOLDER
  3. 途中の処理内容をログとして作業フォルダへテキストファイル出力します。 CON_DEBUG = True
  4. 事前に参照設定が必要です。

<以下サンプルの最終更新日時:2017/03/28 13:59>

Downloadsample-PDDocSetInfo.xls

001 Option Explicit 002 003 Private sXml(4, 3) As String 004 Private sMsg As String 005 Private lRet As Long 006 007 Private Const CON_LAST_TAG = "</rdf:Description>" 008 'Infoの作成者とキーワードの区切り文字 009 Private Const CON_KUGIRI = "," 010 011 ' デバッグ用 012 ' CON_DEBUG = False でLOG出力無し 013 014 Private Const CON_DEBUG = True 015 Private Const CON_WORK_FOLDER = "D:\Temp\Log\" 016 Private msDebugLogFilePath As String 'LOGファイルパス 017 Private mlDebugLogFileNo As Long 'LOGファイルNO 018 Private msDebugLogCnt As Long 'LOGの出力数 019 Private msDebugMsg As String 020 021 022 '================================================== 023 ' テスト用の呼び出し側 024 '================================================== 025 026 Sub Main_Demo() 027 028 Dim sInputPdf As String '入力PDFファイル 029 Dim sOutputPDF As String '出力PDFファイル 030 031 Dim sTitle As String 'タイトル 032 Dim sSubject As String 'サブタイトル 033 Dim sAuthor(1) As String '作成者 034 Dim sKeywords(1) As String 'キーワード 035 Dim sRights As String '著作権情報 036 037 Dim bRet As Boolean '戻り値 038 Dim sMessage As String 'エラーメッセージ 039 040 '入力PDFファイル 041 sInputPdf = "D:\Temp\Log\Test1.PDF" 042 '出力PDFファイル 043 sOutputPDF = "D:\Temp\Log\Test1-OUT2.PDF" 044 045 '▼1.文書プロパティをセットする例 046 sTitle = "■①タイトル" 047 sSubject = "■②サブタイトル" 048 sAuthor(0) = "■③作成者1" 049 sAuthor(1) = "■③作成者2" 050 sKeywords(0) = "■④キーワード1" 051 sKeywords(1) = "■④キーワード2" 052 sRights = "■⑤著作権情報" 053 054 '▼2.文書プロパティを空にする例 055 ' sTitle = "" 'タイトル 056 ' sSubject = "" 'サブタイトル 057 ' sAuthor(0) = "" '作成者 058 ' sKeywords(0) = "" 'キーワード 059 ' sRights = "" '著作権情報 060 061 '▼3.処理をスキップさせる例 062 '※vbNullCharをセット時はその項目を処理しない 063 ' sTitle = vbNullChar 'タイトル 064 ' sSubject = vbNullChar 'サブタイトル 065 ' sAuthor(0) = vbNullChar '作成者 066 ' sKeywords(0) = vbNullChar 'キーワード 067 ' sRights = vbNullChar '著作権情報 068 069 bRet = PDF_Update_MXP_INFO( _ 070 sInputPdf, sOutputPDF, _ 071 sTitle, sSubject, sAuthor(), sKeywords(), sRights, _ 072 sMessage) 073 074 MsgBox "終了" & vbCrLf & sMessage, , _ 075 IIf(sMessage = "", "正常", "エラー") 076 077 End Sub 078 079 080 '================================================== 081 ' 082 ' タイトル: PDFの文書プロパティ(概要)を更新 083 ' 084 ' 更新するのは「タイトル」、「サブタイトル」、 085 ' 「作成者」、「キーワード」、「著作権情報」です。 086 ' 087 ' Create : 2017/03/25 088 ' Update : 2017/09/09 089 ' Vertion : 1.0 090 ' 091 ' 引数1 : sInputPdf As String (IN) 092 ' 入力PDFファイルのフルパス 093 ' 引数2 : sOutputPDF As String (IN) 094 ' 出力PDFファイルのフルパス 095 ' 引数3 : sTitle As String (IN) 096 ' 文書プロパティのタイトル 097 ' 引数4 : sSubject As String (IN) 098 ' 文書プロパティのサブタイトル 099 ' 引数5 : sAuthor() As String (IN) 100 ' 文書プロパティの作成者  複数指定可能 101 ' 引数6 : sKeywords() As String (IN) 102 ' 文書プロパティのキーワード 複数指定可能 103 ' 引数7 : sRights As String (IN) 104 ' 文書プロパティの著作権情報 105 ' 引数8 : sMessage As String (OUT) 106 ' エラー時のメッセージ 107 ' 108 ' 戻り値 : True 正常処理 109 ' False エラー有り 110 ' エラーメッセージは第八引数 sMessage にセットされる 111 ' 112 ' 備考 : 最初は「CON_DEBUG = True」でテストして下さい。 113 ' URL : http://pdf-file.nnn2.com/?p=928 114 ' その他 : 著作権等は主張しません。 115 ' 上記URLにコメントを頂けると嬉しいです。 116 ' 117 '================================================== 118 119 Public Function PDF_Update_MXP_INFO( _ 120 ByVal sInputPdf As String, _ 121 ByVal sOutputPDF As String, _ 122 ByVal sTitle As String, _ 123 ByVal sSubject As String, _ 124 ByRef sAuthor() As String, _ 125 ByRef sKeywords() As String, _ 126 ByVal sRights As String, _ 127 ByRef sMessage As String) As Boolean 128 129 Dim sFileName As String '拡張子無しのファイル名 130 Dim sWorkFile(2) As String '作業PDFファイル 131 132 Dim sAuthor_X() As String '作成者 133 Dim sKeywords_X() As String 'キーワード 134 Dim i As Long '添字 135 Dim j As Long '添字 136 137 PDF_Update_MXP_INFO = True 138 139 '入力PDFの拡張子無しのファイル名を取得 140 sFileName = Mid$(sInputPdf, _ 141 InStrRev(sInputPdf, "\") + 1, _ 142 InStrRev(sInputPdf, ".") - InStrRev(sInputPdf, "\") - 1) 143 144 'ログ・ファイルの前処理 145 If CON_DEBUG Then 146 Call Degug_log_Init(sFileName) 147 Call Degug_Put_log("In PDF-File : " & sInputPdf) 148 Call Degug_Put_log("OUT PDF-File : " & sOutputPDF) 149 Call Degug_Put_log( _ 150 "■ Info -> XMP ■ 区切り文字は(" & CON_KUGIRI & ")") 151 End If 152 153 '▼前処理 154 Call UpdatePDF_XMP_INFO_INIT 155 sFileName = sFileName & Format(Date, "-yyyymmdd-") 156 If CON_DEBUG Then Call Debug_PDF_Data(sInputPdf) 157 sWorkFile(0) = CON_WORK_FOLDER & sFileName & _ 158 Format(Time, "hhmmss") & "-0.pdf" 159 sWorkFile(1) = CON_WORK_FOLDER & sFileName & _ 160 Format(Time, "hhmmss") & "-1.pdf" 161 If sAuthor(0) <> vbNullChar And sAuthor(0) <> "" Then 162 sWorkFile(2) = CON_WORK_FOLDER & sFileName & _ 163 Format(Time, "hhmmss") & "-2.pdf" 164 Else 165 sWorkFile(2) = sOutputPDF 166 End If 167 168 '▼PDF内のゴミを取る為に別名で最適化保存する。 169 Call UpdatePDF_SaveAs(sInputPdf, sWorkFile(0), sMsg) 170 171 If sMsg <> "" Then 'エラー発生 172 PDF_Update_MXP_INFO = False 173 GoTo Skip_PDF_Update_MXP_INFO: 174 End If 175 If CON_DEBUG Then Call Debug_PDF_Data(sWorkFile(0)) 176 177 '▼Infoの更新 178 Call UpdatePDF_INFO(sWorkFile(0), sWorkFile(1), _ 179 sTitle, sSubject, sAuthor(), sKeywords(), sRights, sMsg) 180 181 If sMsg <> "" Then 'エラー発生 182 PDF_Update_MXP_INFO = False 183 GoTo Skip_PDF_Update_MXP_INFO: 184 End If 185 If CON_DEBUG Then Call Debug_PDF_Data(sWorkFile(1)) 186 187 '▼XMPの更新 188 Call UpdatePDF_XMP(sWorkFile(1), sWorkFile(2), _ 189 sTitle, sSubject, sAuthor(), sKeywords(), sRights, sMsg) 190 191 If sMsg <> "" Then 'エラー発生 192 PDF_Update_MXP_INFO = False 193 GoTo Skip_PDF_Update_MXP_INFO: 194 End If 195 If CON_DEBUG Then Call Debug_PDF_Data(sWorkFile(2)) 196 197 If sWorkFile(2) <> sOutputPDF Then 198 '▼XMPの作成者のみ再更新 ※Acrobat不具合の対応? 199 ReDim sAuthor_X(UBound(sAuthor)) As String 200 For i = 0 To UBound(sAuthor) 201 sAuthor_X(i) = sAuthor(i) 202 Next i 203 ReDim sKeywords_X(UBound(sKeywords)) As String 204 For i = 0 To UBound(sKeywords) 205 sKeywords_X(i) = vbNullChar 206 Next i 207 208 Call UpdatePDF_XMP(sWorkFile(2), sOutputPDF, _ 209 vbNullChar, vbNullChar, _ 210 sAuthor_X(), sKeywords_X(), vbNullChar, sMsg) 211 212 If sMsg <> "" Then 'エラー発生 213 PDF_Update_MXP_INFO = False 214 GoTo Skip_PDF_Update_MXP_INFO: 215 End If 216 If CON_DEBUG Then Call Debug_PDF_Data(sOutputPDF) 217 End If 218 219 Skip_PDF_Update_MXP_INFO: 220 If CON_DEBUG Then Call Degug_Put_log("■終了") 221 222 If CON_DEBUG Then Stop '一時停止 223 On Error Resume Next 224 '作業ファイルの削除 225 Kill sWorkFile(0) 226 Kill sWorkFile(1) 227 If sWorkFile(2) <> sOutputPDF Then Kill sWorkFile(2) 228 End Function 229 230 231 '-------------------------------------------------- 232 ' 変数の初期化 233 '-------------------------------------------------- 234 235 Private Sub UpdatePDF_XMP_INFO_INIT() 236 237 'XMPの要素名をセット 238 'タイトル 239 sXml(0, 0) = "dc:title" 240 sXml(0, 1) = "rdf:Alt" 241 sXml(0, 2) = "rdf:li" 242 sXml(0, 3) = "xml:lang=""x-default""" 243 244 'サブタイトル 245 sXml(1, 0) = "dc:description" 246 sXml(1, 1) = "rdf:Alt" 247 sXml(1, 2) = "rdf:li" 248 sXml(1, 3) = "xml:lang=""x-default""" 249 250 '作成者 251 sXml(2, 0) = "dc:creator" 252 sXml(2, 1) = "rdf:Seq" 253 sXml(2, 2) = "rdf:li" '複数有り 254 sXml(2, 3) = "" 255 256 'キーワード 257 sXml(3, 0) = "dc:subject" 258 sXml(3, 1) = "rdf:Bag" 259 sXml(3, 2) = "rdf:li" '複数有り 260 sXml(3, 3) = "" 261 262 '著作権情報 263 sXml(4, 0) = "dc:rights" 264 sXml(4, 1) = "rdf:Alt" 265 sXml(4, 2) = "rdf:li" 266 sXml(4, 3) = "xml:lang=""x-default""" 267 268 '初期化 269 sMsg = "" 270 271 End Sub 272 273 '-------------------------------------------------- 274 ' PDFファイルを最適化して別名保存 275 '-------------------------------------------------- 276 277 Private Sub UpdatePDF_SaveAs( _ 278 ByVal sInputPdf As String, _ 279 ByRef sOutputPDF As String, _ 280 ByRef sMsg As String) 281 282 Dim objAcroPDDoc As New Acrobat.AcroPDDoc 283 284 'PDFのオープン 285 lRet = objAcroPDDoc.Open(sInputPdf) 286 If lRet = 0 Then 287 sMsg = sInputPdf & vbCrLf & _ 288 "1.PDFファイルがオープン出来なかった。" 289 If CON_DEBUG Then Call Degug_Put_log(sMsg) 290 Exit Sub 291 End If 292 293 '① 最適化で別名保存。 294 '別名でPDFファイルを保存する 295 lRet = objAcroPDDoc.Save _ 296 (PDSaveFull + PDSaveLinearized + _ 297 PDSaveCollectGarbage, _ 298 sOutputPDF) 299 If lRet = 0 Then 300 sMsg = sOutputPDF & vbCrLf & _ 301 "2.PDFファイルが保存出来なかった。" 302 If CON_DEBUG Then Call Degug_Put_log(sMsg) 303 Exit Sub 304 End If 305 306 objAcroPDDoc.Close 307 Set objAcroPDDoc = Nothing 308 309 End Sub 310 311 '-------------------------------------------------- 312 ' Infoの更新 313 ' 314 '-------------------------------------------------- 315 316 Private Sub UpdatePDF_INFO( _ 317 ByVal sInputPdf As String, _ 318 ByRef sOutputPDF As String, _ 319 ByVal sTitle As String, _ 320 ByVal sSubject As String, _ 321 ByRef sAuthor() As String, _ 322 ByRef sKeywords() As String, _ 323 ByVal sRights As String, _ 324 ByRef sMsg As String) 325 326 Dim objAcroAVDoc As New Acrobat.AcroAVDoc 327 Dim objAcroPDDoc As New Acrobat.AcroPDDoc 328 Dim sInfo As String 329 Dim i As Long 330 Dim j As Long 331 332 If CON_DEBUG Then Call Degug_Put_log("■Info情報の更新■" & vbCrLf) 333 334 objAcroAVDoc.Close 1 '※エラー回避ロジック 335 'PDFのオープン 336 lRet = objAcroAVDoc.Open(sInputPdf, "") 337 If lRet = 0 Then 338 sMsg = sInputPdf & vbCrLf & _ 339 "[UpdatePDF_INFO].PDFファイルがオープン出来なかった。" 340 If CON_DEBUG Then Call Degug_Put_log(sMsg) 341 GoTo End_UpdatePDF_INFO: 342 End If 343 344 msDebugMsg = "" 345 346 '文書ディクショナリ(Info)の更新 347 With objAcroAVDoc.GetPDDoc.GetJSObject 348 'タイトル 349 If sTitle <> vbNullChar Then 350 msDebugMsg = "title(B):" & .info.Title & vbCrLf 351 .info.Title = sTitle 352 msDebugMsg = msDebugMsg & "title(A):" & .info.Title _ 353 & vbCrLf 354 End If 355 'サブタイトル 356 If sSubject <> vbNullChar Then 357 msDebugMsg = msDebugMsg & "Subject(B):" & .info.Subject _ 358 & vbCrLf 359 .info.Subject = sSubject 360 msDebugMsg = msDebugMsg & "Subject(A):" & .info.Subject _ 361 & vbCrLf 362 End If 363 '作成者 364 If sAuthor(0) <> vbNullChar Then 365 msDebugMsg = msDebugMsg & "Author(B):" & .info.Author _ 366 & vbCrLf 367 sInfo = sAuthor(0) 368 For j = 1 To UBound(sAuthor) 369 If Not (sAuthor(j) = "" Or _ 370 sAuthor(j) = vbNullString) Then 371 sInfo = sInfo & CON_KUGIRI & sAuthor(j) 372 End If 373 Next j 374 .info.Author = sInfo 375 msDebugMsg = msDebugMsg & "Author(A):" & .info.Author _ 376 & vbCrLf 377 End If 378 'キーワード 379 If sKeywords(0) <> vbNullChar Then 380 msDebugMsg = msDebugMsg & "Keywords(B):" & .info.Keywords _ 381 & vbCrLf 382 sInfo = sKeywords(0) 383 For j = 1 To UBound(sKeywords) 384 If Not (sKeywords(j) = "" Or _ 385 sKeywords(j) = vbNullString) Then 386 sInfo = sInfo & CON_KUGIRI & sKeywords(j) 387 End If 388 Next j 389 .info.Keywords = sInfo 390 msDebugMsg = msDebugMsg & "Keywords(A):" & .info.Keywords _ 391 & vbCrLf 392 End If 393 '著作権情報 394 'サブタイトル 395 If sRights <> vbNullChar Then 396 msDebugMsg = msDebugMsg & "Rights(B):" & .info.Rights _ 397 & vbCrLf 398 .info.Rights = sRights 399 msDebugMsg = msDebugMsg & "Rights(A):" & .info.Rights _ 400 & vbCrLf 401 End If 402 403 End With 404 405 If CON_DEBUG Then Call Degug_Put_log(msDebugMsg) 406 407 '別名でPDFファイルを保存する 408 Set objAcroPDDoc = objAcroAVDoc.GetPDDoc 409 lRet = objAcroPDDoc.Save _ 410 (PDSaveFull + PDSaveLinearized + _ 411 PDSaveCollectGarbage, _ 412 sOutputPDF) 413 If lRet = 0 Then 414 sMsg = sOutputPDF & vbCrLf & _ 415 "[UpdatePDF_INFO].PDFファイルが保存出来なかった。" 416 If CON_DEBUG Then Call Degug_Put_log(sMsg) 417 GoTo End_UpdatePDF_INFO: 418 End If 419 420 End_UpdatePDF_INFO: 421 objAcroAVDoc.Close 1 '保存しないで閉じる 422 objAcroPDDoc.Close 423 Set objAcroAVDoc = Nothing 424 Set objAcroPDDoc = Nothing 425 426 End Sub 427 428 '-------------------------------------------------- 429 ' メタデータ・XMP(Xml)の更新 430 ' 431 '-------------------------------------------------- 432 433 Private Sub UpdatePDF_XMP( _ 434 ByVal sInputPdf As String, _ 435 ByRef sOutputPDF As String, _ 436 ByVal sTitle As String, _ 437 ByVal sSubject As String, _ 438 ByRef sAuthor() As String, _ 439 ByRef sKeywords() As String, _ 440 ByVal sRights As String, _ 441 ByRef sMsg As String) 442 443 Dim objAcroAVDoc As New Acrobat.AcroAVDoc 444 Dim objAcroPDDoc As New Acrobat.AcroPDDoc 445 Dim sMetaData As String 446 Dim sData As String 447 Dim sMetaOut As String 448 Dim sReplaceData As String 449 Dim sTestData1 As String 450 Dim x1 As Long 451 Dim x2 As Long 452 Dim sInfo As String 453 Dim i As Long 454 Dim j As Long 455 456 If CON_DEBUG Then Call Degug_Put_log("■XMP 情報の更新■") 457 458 objAcroAVDoc.Close 1 '※エラー回避ロジック 459 'PDFのオープン 460 lRet = objAcroAVDoc.Open(sInputPdf, "") 461 If lRet = 0 Then 462 sMsg = sInputPdf & vbCrLf & _ 463 "UpdatePDF_XMP:PDFファイルがオープン出来なかった。" 464 If CON_DEBUG Then Call Degug_Put_log(sMsg) 465 GoTo End_UpdatePDF_XMP: 466 End If 467 468 'メタデータの取得 469 With objAcroAVDoc.GetPDDoc.GetJSObject 470 sMetaData = .metadata 471 End With 472 473 '登録又は置き換えるメタデータを事前に作成する 474 For i = 0 To UBound(sXml, 1) 475 If i = 0 And (sTitle = vbNullChar Or sTitle = "") _ 476 Then GoTo Skip_Next1: 477 If i = 1 And (sSubject = vbNullChar Or sSubject = "") _ 478 Then GoTo Skip_Next1: 479 If i = 2 And (sAuthor(0) = vbNullChar Or sAuthor(0) = "") _ 480 Then GoTo Skip_Next1: 481 If i = 3 And (sKeywords(0) = vbNullChar Or sKeywords(0) = "") _ 482 Then GoTo Skip_Next1: 483 If i = 4 And (sRights = vbNullChar Or sRights = "") _ 484 Then GoTo Skip_Next1: 485 486 sMetaOut = "<" & sXml(i, 0) & ">" & vbCrLf 487 sMetaOut = sMetaOut & "<" & sXml(i, 1) & ">" & vbCrLf 488 If (i = 0) Or (i = 1) Or (i = 4) Then 489 '配列無し 490 sMetaOut = sMetaOut & _ 491 "<" & sXml(i, 2) & " " & sXml(i, 3) & ">" 492 Select Case i 493 Case 0: sMetaOut = sMetaOut & sTitle 494 Case 1: sMetaOut = sMetaOut & sSubject 495 Case 4: sMetaOut = sMetaOut & sRights 496 End Select 497 sMetaOut = sMetaOut & "</" & sXml(i, 2) & ">" & vbCrLf 498 Else 499 '配列有り 500 Select Case i 501 Case 2 502 For j = 0 To UBound(sAuthor) 503 If sAuthor(j) <> "" Then 504 sMetaOut = sMetaOut & _ 505 "<" & sXml(i, 2) & ">" & sAuthor(j) & _ 506 "</" & sXml(i, 2) & ">" & vbCrLf 507 End If 508 Next j 509 Case 3 510 For j = 0 To UBound(sKeywords) 511 If sKeywords(j) <> "" Then 512 sMetaOut = sMetaOut & _ 513 "<" & sXml(i, 2) & ">" & sKeywords(j) & _ 514 "</" & sXml(i, 2) & ">" & vbCrLf 515 End If 516 Next j 517 End Select 518 End If 519 sMetaOut = sMetaOut & "</" & sXml(i, 1) & ">" & vbCrLf 520 sMetaOut = sMetaOut & "</" & sXml(i, 0) & ">" 521 522 'メタデータの更新 523 x1 = InStr(sMetaData, "<" & sXml(i, 0) & ">") 524 x2 = InStr(x1 + _ 525 Len(sXml(i, 0)), sMetaData, "</" & sXml(i, 0) & ">") 526 If x1 = 0 Then 527 '存在しないので追加する 528 sTestData1 = Replace(sMetaData, CON_LAST_TAG, _ 529 sMetaOut & vbCrLf & CON_LAST_TAG) 530 Else 531 '存在するので置き換える。 532 sReplaceData = Mid$(sMetaData, x1, _ 533 (x2 + Len("</" & sXml(i, 0) & ">")) - x1) 534 sTestData1 = Replace(sMetaData, sReplaceData, sMetaOut) 535 End If 536 537 sMetaData = sTestData1 538 Skip_Next1: 539 Next i 540 541 '削除する場合 542 For i = 0 To UBound(sXml, 1) 543 If i = 0 And sTitle = "" Then GoTo Skip_Next2_Update: 544 If i = 1 And sSubject = "" Then GoTo Skip_Next2_Update: 545 If i = 2 And sAuthor(0) = "" Then GoTo Skip_Next2_Update: 546 If i = 3 And sKeywords(0) = "" Then GoTo Skip_Next2_Update: 547 If i = 4 And sRights = "" Then GoTo Skip_Next2_Update: 548 GoTo Skip_Next2 549 550 Skip_Next2_Update: 551 'メタデータの更新 552 x1 = InStr(sMetaData, "<" & sXml(i, 0) & ">") 553 x2 = InStr(x1 + Len(sXml(i, 0)), sMetaData, "</" & sXml(i, 0) & ">") 554 If x1 <> 0 Then 555 '存在するので削除する。 556 sReplaceData = Mid$(sMetaData, x1, (x2 + Len("</" & sXml(i, 0) & ">")) - x1) 557 sTestData1 = Replace(sMetaData, sReplaceData, "") 558 End If 559 560 sMetaData = sTestData1 561 Skip_Next2: 562 Next i 563 564 '※今回は以下の処理が不要になりましたが改造時の為に残す 565 ' Const CON_KEYWORDS = "pdf:Keywords=""" 566 ' If sKeywords(0) <> vbNullChar Then 567 ' If sKeywords(0) = "" Then 568 ' '削除処理 569 ' x1 = InStr(sMetaData, CON_KEYWORDS) 570 ' x2 = InStr(x1 + Len(CON_KEYWORDS), sMetaData, """") 571 ' If x1 <> 0 Then 572 ' '存在するので削除する。 573 ' sReplaceData = Mid$(sMetaData, x1, _ 574 ' (x2 + Len(CON_KEYWORDS)) - x1) 575 ' If CON_DEBUG Then Debug.Print _ 576 ' "sReplaceData(削除)=" & vbCrLf & sReplaceData 577 ' sTestData1 = Replace(sMetaData, sReplaceData, "") 578 ' End If 579 ' Else 580 ' '追加or更新の処理 581 ' sMetaOut = sKeywords(0) 582 ' For j = 1 To UBound(sKeywords) 583 ' If Not (sKeywords(j) = "" Or _ 584 ' sKeywords(j) = vbNullString) Then 585 ' sMetaOut = sMetaOut & ";" & sKeywords(j) 586 ' End If 587 ' Next j 588 ' sMetaOut = CON_KEYWORDS & sMetaOut & """" 589 ' 590 ' x1 = InStr(sMetaData, CON_KEYWORDS) 591 ' x2 = InStr(x1 + Len(CON_KEYWORDS), sMetaData, """") 592 ' If x1 = 0 Then 593 ' '存在しないので追加する 594 ' '※[xmpMM:DocumentID=]の前に入れる 595 ' sTestData1 = Replace(sMetaData, "xmpMM:DocumentID=", _ 596 ' sMetaOut & vbCrLf & "xmpMM:DocumentID=") 597 ' sMetaData = sTestData1 598 ' Else 599 ' '存在するので更新する 600 ' sReplaceData = Mid$(sMetaData, x1, (x2 - x1 + 1)) 601 ' sTestData1 = Replace(sMetaData, sReplaceData, sMetaOut) 602 ' sMetaData = sTestData1 603 ' End If 604 ' If CON_DEBUG Then Debug.Print _ 605 ' "▼Keywords▼" & vbCrLf & sTestData1 606 ' End If 607 ' End If 608 609 If CON_DEBUG Then _ 610 Call Degug_Put_log("編集後のsMetaDataの値=" & vbCrLf & sMetaData) 611 612 'XMPデータの更新 613 With objAcroAVDoc.GetPDDoc.GetJSObject 614 .metadata = sMetaData 615 End With 616 617 '別名でPDFファイルを最適化・保存する 618 Set objAcroPDDoc = objAcroAVDoc.GetPDDoc 619 lRet = objAcroPDDoc.Save _ 620 (PDSaveFull + PDSaveLinearized + _ 621 PDSaveCollectGarbage, _ 622 sOutputPDF) 623 If lRet = 0 Then 624 sMsg = sOutputPDF & vbCrLf & _ 625 "UpdatePDF_XMP:PDFファイルが保存出来なかった。" 626 If CON_DEBUG Then Call Degug_Put_log(sMsg) 627 GoTo End_UpdatePDF_XMP: 628 End If 629 630 End_UpdatePDF_XMP: 631 objAcroAVDoc.Close 1 '保存しないで閉じる 632 objAcroPDDoc.Close 633 Set objAcroAVDoc = Nothing 634 Set objAcroPDDoc = Nothing 635 636 End Sub 637 638 '************************************************** 639 ' 640 ' LOG の出力 : デバッグ&確認用 641 ' 642 ' テスト完了後はCON_DEBUG = Falseにするか、 643 ' これ以降を削除してください。 644 ' 645 '************************************************** 646 647 Private Sub Debug_PDF_Data(sInputPdf As String) 648 649 Dim objAcroAVDocX As New Acrobat.AcroAVDoc 650 Dim lRet As Long 651 Dim sDebug As String 652 653 objAcroAVDocX.Close 1 '※エラー回避ロジック 654 lRet = objAcroAVDocX.Open(sInputPdf, "") 655 If lRet = 0 Then 656 msDebugMsg = sInputPdf & vbCrLf & _ 657 "Debug_PDF_DataP:PDFファイルが保存出来なかった。" 658 Call Degug_Put_log(msDebugMsg) 659 Exit Sub 660 End If 661 sDebug = "▼Input-PDF:" & sInputPdf & vbCrLf 662 663 With objAcroAVDocX.GetPDDoc.GetJSObject 664 sDebug = sDebug & "MetaData(x)=" & vbCrLf & .metadata & vbCrLf 665 666 '文書ディクショナリ(Info)の情報 667 'タイトル 668 sDebug = sDebug & "title(x):" & .info.Title & vbCrLf 669 'サブタイトル 670 sDebug = sDebug & "Subject(x):" & .info.Subject & vbCrLf 671 '作成者 672 sDebug = sDebug & "Author(x):" & .info.Author & vbCrLf 673 'キーワード 674 sDebug = sDebug & "Keywords(x):" & .info.Keywords & vbCrLf 675 '著作権情報 676 sDebug = sDebug & "Rights(x):" & .info.Rights & vbCrLf 677 End With 678 679 Call Degug_Put_log(sDebug) 'LOGファイルへ出力 680 681 objAcroAVDocX.Close 1 '保存しないで閉じる 682 Set objAcroAVDocX = Nothing 683 End Sub 684 685 ' 前処理 686 687 Private Sub Degug_log_Init( _ 688 ByVal sInFileName As String) 689 690 mlDebugLogFileNo = FreeFile 691 msDebugLogFilePath = CON_WORK_FOLDER & sInFileName & "-log-" & _ 692 Format(Date, "yyyymmdd-") & Format(Time, "hhmmss") & ".txt" 693 msDebugLogCnt = 0 694 End Sub 695 696 ' LOGファイルへ出力 697 698 Private Sub Degug_Put_log( _ 699 ByVal sDeug As String) 700 701 msDebugLogCnt = msDebugLogCnt + 1 702 Open msDebugLogFilePath For Append As #mlDebugLogFileNo 703 Print #mlDebugLogFileNo, _ 704 "(" & msDebugLogCnt & ") " & _ 705 Format(Date, "yyyy/mm/dd") & _ 706 Format(Time, " hh:mm:ss") & _ 707 vbCrLf & sDeug & vbCrLf 708 Close #mlDebugLogFileNo 709 710 End Sub 711


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

結果

上記サンプルの実行結果です。

関数:PDFの文書プロパティを更新
関数:PDFの文書プロパティを更新
関数:PDFの文書プロパティを更新
Source file 001 <x:xmpmeta xmlns:x="adobe:ns:meta/" x:xmptk="Adobe XMP Core 5.4-c005 78.147326, 2012/08/23-13:03:03 "> 002 <rdf:RDF xmlns:rdf="http://www.w3.org/1999/02/22-rdf-syntax-ns#"> 003 <rdf:Description rdf:about="" 004 xmlns:xmp="http://ns.adobe.com/xap/1.0/" 005 xmlns:dc="http://purl.org/dc/elements/1.1/" 006 xmlns:pdf="http://ns.adobe.com/pdf/1.3/" 007 xmlns:xmpMM="http://ns.adobe.com/xap/1.0/mm/" 008 xmlns:pdfx="http://ns.adobe.com/pdfx/1.3/" 009 xmp:CreateDate="1996-11-30T13:07:53Z" 010 xmp:CreatorTool="FrameMaker 5.1" 011 xmp:ModifyDate="2017-03-25T17:36:56+09:00" 012 xmp:MetadataDate="2017-03-25T17:36:56+09:00" 013 dc:format="application/pdf" 014 pdf:Keywords="■④キーワード1,■④キーワード2" 015 pdf:Producer="Acrobat Distiller 3.0 for Power Macintosh" 016 xmpMM:DocumentID="uuid:********-****-****-****-************" 017 xmpMM:InstanceID="uuid:********-****-****-****-************" 018 pdfx:Rights="■⑤著作権情報"> 019 <dc:description> 020 <rdf:Alt> 021 <rdf:li xml:lang="x-default">■②サブタイトル</rdf:li> 022 </rdf:Alt> 023 </dc:description> 024 <dc:creator> 025 <rdf:Seq> 026 <rdf:li>■③作成者1</rdf:li> 027 <rdf:li>■③作成者2</rdf:li> 028 </rdf:Seq> 029 </dc:creator> 030 <dc:title> 031 <rdf:Alt> 032 <rdf:li xml:lang="x-default">■①タイトル</rdf:li> 033 </rdf:Alt> 034 </dc:title> 035 <dc:subject> 036 <rdf:Bag> 037 <rdf:li>■④キーワード1</rdf:li> 038 <rdf:li>■④キーワード2</rdf:li> 039 </rdf:Bag> 040 </dc:subject> 041 <dc:rights> 042 <rdf:Alt> 043 <rdf:li xml:lang="x-default">■⑤著作権情報</rdf:li> 044 </rdf:Alt> 045 </dc:rights> 046 </rdf:Description> 047 </rdf:RDF> 048 </x:xmpmeta>


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

 

但し、残念な事にOLEのInfo内容で作成者は1番目しかセットされませんでした。以下はログファイルからの結果です。

Source file title(x):■①タイトル Subject(x):■②サブタイトル Author(x):■③作成者1 Keywords(x):■④キーワード1,■④キーワード2 Rights(x):■⑤著作権情報

 

Author(x)は下記が正解です。本当は以下の様にならないと駄目なハズ。
Author(x):■③作成者1,■③作成者2

 

既知の問題

  1. 文書プロパティの作成者を配列で複数指定してもGetInfo の結果は1つ目しか返されません。これに対する逃げ手は現時点(2017/3/25)では見つかっていません。
  2. 文書プロパティの作成者とキーワードの区切りは画面上ではカンマ「 , 」やセミコロン「 ; 」で表示されます。更に前後をダブルクオーテーションで表示される場合が有ります。

「XMPの結果」を今は最優先とし、上記の「既知の問題」に関しては余力が出来た時に再検討&再調査とします。

備考

  1. 当関数を改造すれば他のPDFのプロパティ項目も変更可能になると予測しています。しかし、その為にはXMPの知識が必要になります。よってXMPの扱いがよく判らない人は、コメントを頂ければ出来る範囲でご助言いたします。
  2. XMPはXMLファイルと同じなのでXMLパーサーを使ってVBAで処理をするのが本来の形です。しかしこのXMLの変形型のXMPをXMLパーサーで扱うのは実際は容易ではなかったです。よってVBAの文字列関数を駆使して処理をしました。
  3. XML内の以下の行は編集しなくても関数内のXML更新で自動的にOLE更新されます。一応、将来的な改造用に関数には更新ロジックをコメントで残してあります。
    • df:Keywords="■④キーワード1,■④キーワード2"
    • pdfx:Rights="■⑤著作権情報"

参考

  1. 文書プロパティを構成するメタデータと文書情報ディクショナリーについて。
  2. OLEからMetaDataとInfoの操作について。
    JavaScript for Acrobat API Reference Adobe Acrobat SDK バージョン 8.0
  3. XMPに関してダウンロードできるPDF文書とサンプル。

動作確認環境

  • Windows 10 Pro 64bit + Acrobat Pro XI  + Excel 2007

< 関数へ戻る >


<管理者の技術メモ>

これ以降はサイト管理人の技術関連メモです。見なくて結構です。

  1. メタデータ(XMP)と文書情報ディクショナリー(Info)がどのように関係して連携?しているのかが不明。PDFの内部を追ってみたが分からなかった。ココは非公開的な内容なのかもしれない。
  2. テスト結果から予測すると、複数指定可能なプロパティにはバグっぽい臭いが、ヤヤする。と言えども、それをカバーする関数処理が出来なかった事が悔しい。
  3. PDFのXMPに関する日本語の説明書(PDF等)は存在しなかった。
  4. 英語版のXMPの説明書はPDF専門の内容では無いが、かなり参考になった。説明内にはXMPのサンプルも豊富に入っている。タブン、これが唯一のXMPに関する最良の説明書と思われる。
  5. 他にもPDFのXMPデータを出力するコマンドラインツールは存在するが、これを更に読み込んでXMPを更新するツールは存在しない。
    PDFtkに似たような機能が合ったが、正常に機能しなかった。
    XMPのインポートとエクスポートの両方が出来るのは、調べた限りではAcrobatアプリ本体のみ。
    但し、当関数を参考にすればXMPのインポートとエクスポートを簡単に行うことが出来ることが分かる。
  6. 他のXMP要素名はココに書いてある内容かな? このXMPSpecificationPart1.pdf ファイル は上記のダウンロードZIPファイルに含まれている。
  7. XMPの<rdf:Bag> <rdf:Seq> <rdf:Alt >の説明に関してはココ<の7.7 Array valued XMP properties>に有る。
    テストでは別の要素名に書き換えても影響しないみたいで結果は同じだった。
  8. VBAソース内の<と>文字はHTMLコードと一部が見なされて、誤変換されたり、強制削除されてしまう。後々のメンテが面倒なので貼り付ける時は<、>文字は全角文字に一括変換してからWEB公開する。サンプルを利用する側に少し手間が掛かるが、メンテナンスする側の方が何倍も大変なので、ハイ。
    半角に戻す注意事項も忘れずにシツコイぐらい書いて置きました。

     

    • IF 命令内の比較演算子 <、>文字は問題無い。
    • ”<” 、”>” 、”</” が誤認識、又は強制排除(削除)される。

< 関数へ戻る >

コメントを残す

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

CAPTCHA


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


SAMURAI Plugin

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

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

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