TOP > サンプル/関数 > 関数:PDFの文書プロパティ(概要)を更新 [...]
概要
SetInfo メソッドでは完全にPDFのプロパティを更新できない時に使用する関数です。PDFファイル内のメタデータ(XMP)と文書情報ディクショナリー(Info)に有る以下の項目を更新します。
- タイトル
- サブタイトル
- 作成者
- キーワード ※上書きします。
- 著作権情報
機能
- 入力PDFから不要なオブジェクト類を消す為に最初に最適化します。
- 文書情報ディクショナリー(Info)情報を更新します。
- メタデータ(XMP)を取り出して更新します。
- 結果を出力PDFへ最適化して保存します。
- CON_DEBUG = True の時は各処理内容の詳細なログをテキストファイルへ出力します。
注意事項
- キーワードに関して、当関数は上書きします。
- SetInfo メソッド、GetInfoメソッド、Acrobatのプロパティ画面、Acrobatのプロパティの詳細(XMP)画面との内容はそれぞれ異なる場合が有ります。当関数では全ての結果が同じになるように処理をします。
※但し、次の「3.」の場合の注意点は回避出来ませんでした。 - 当関数では、作成者を2つ以上登録しようとしてもInfoデータ(GetInfo の結果)には1番目しか登録されません。
- 作成者、キーワードの文字列に小文字のカンマ「,」とセミコロン「;」は使用できません。区切り文字として判断されてしまう為です。
どうしても使用したい時は文字列の前後をダブルクオーテーションで囲ってください。※CSVデータの扱いと同じみたいです。
但しダブルクオーテーションを使うと予期せぬ結果になる場合があります。その場合はカンマとセミコロンを全角に変更してなどして判断してください。 - メタデータ(XMP)と文書情報ディクショナリー(Info)の扱い方に疑問が有ります。AcrobatのOLEの動作に一部理解できない部分が有ります。よって必ず事前に動作確認をしてから、ご使用ください。
- 関数を動作させる前に 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編)
引数
- 第一引数 ( string sInputPdf ) :
入力PDF ファイルのフルパス - 第二引数 ( string sOutputPDF ) :
出力PDF ファイルのフルパス - 第三引数 ( string sTitle ) :
文書プロパティのタイトル - 第四引数 ( string sSubject ) :
文書プロパティのサブタイトル - 第五引数 ( string sAuthor( ) ) :
文書プロパティの作成者
配列で複数指定可能。但し注意有り。 - 第六引数 ( string sKeywords( ) ) :
文書プロパティのキーワード
配列で複数指定可能 - 第七引数 ( string sRights ) :
文書プロパティの著作権情報 - 第八引数 ( string sMessage ) :
関数内でエラー時のみにセットされるエラーメッセージ
- 「タイトル」、「サブタイトル」、「作成者」、「キーワード」、「著作権情報」を処理したくない時は vbNullChar をセットします。0バイト文字 ”” の時は該当の文書プロパティを空にします。詳細はサンプルを参照してください。
戻り値
- True : 正常終了。
- False : エラー有り。第八引数に詳細なエラーメッセージがセットされます。
サンプル
- Test1.PDF の「タイトル」、「サブタイトル」、「作成者」、「キーワード」、「著作権情報」を更新し、Test1-OUT1.PDFで出力します。
- タイトル: "■①タイトル"
- サブタイトル: "■②サブタイトル"
- 作成者の1番目: "■③作成者1"
- 作成者の2番目: "■③作成者2"
- キーワードの1番目: "■④キーワード1"
- キーワードの2番目: "■④キーワード2"
- 著作権情報: "■⑤著作権情報"
- 作業フォルダは "D:¥Temp¥Log¥" です。CON_WORK_FOLDER
- 途中の処理内容をログとして作業フォルダへテキストファイル出力します。 CON_DEBUG = True
- 事前に参照設定が必要です。
<以下サンプルの最終更新日時:2017/03/28 13:59>
Download:sample-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 : https://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編)
結果
上記サンプルの実行結果です。
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>