リッチテキスト内の名刺画像が写真（= インラインイメージ）の場合、画像テータを添付ファイルに変換します。インラインイメージの操作は、通常の NotesRichText* クラスでは実現できません。そこで、今回も DXL を利用します。
インラインイメージを添付ファイルに変換
まずはこの処理のメイン関数 xConvPhoto2Attach を紹介します。
この関数はリッチテキスト内のインラインイメージを添付ファイルに変換する関数ですが、次の手順で処理を行います。
- リッチテキスト内からインラインイメージデータ（Base64）を文字列で取得
- リッチテキスト内のイメージデータを削除
- リッチテキストに添付ファイル（の参照）を作成
- 添付ファイルの実体を文書に追加
- 文書を保存（DXL 経由）
各手順はサブ関数により実現しています。
Private Function xConvPhoto2Attach(rndNameCard As NotesDocument, ByVal vsFld As String) As Boolean
Dim sBase64 As String
Dim sID As String
Dim sTag As String
Dim sName As String
'名刺情報が保存された文書を取得（再取得）
sID = rndNameCard.Noteid
Set rndNameCard = Nothing '一旦文書開放
Set rndNameCard = xndb.GetDocumentByID(sID)
'① インラインイメージデータ（Base64）取得
sBase64 = xGetDXL_FirstInlineImage64(rndNameCard, vsFld, sTag)
sName = "NameCard." & sTag 'ファイル名
'DXL の準備
Dim dprs As NotesDOMParser
Set dprs = xGetDOMParser(rndNameCard)
'DOM ツリーのルートを取得
Dim ddn As NotesDOMDocumentNode
Set ddn = dprs.Document
'リッチテキストの取得
Dim denRT As NotesDOMElementNode
Set denRT = xGetDXL_item(ddn, vsFld)
'イメージデータのある段落を取得
Dim denPar As NotesDOMElementNode
Set denPar = xGetDXL_FirstNodeByName(denRT, "par")
'インラインイメージを添付ファイルに変換
'② 既存のコンテンツ（=インラインイメージ）を削除
Call xConvP2A_DelImage(denPar)
'③ 添付ファイル（=実体に対する参照）を追加
Call xConvP2A_AddAttachRef(ddn, denPar, sName)
'④ 添付ファイルの実体を追加
Call xConvP2A_AddAttach(ddn, sName, sBase64)
'⑤ 文書の保存（DXL 経由）
If xSaveDXL_Update(dprs) Then
'更新した文書を再取得
sID = rndNameCard.Noteid
Set rndNameCard = Nothing '一旦文書開放
Set rndNameCard = xndb.GetDocumentByID(sID)
End If
End Function
|
① のインラインイメージデータ（Base64）取得については既存の関数 xGetDXL_FirstInlineImage64 を利用しています。ただ、今回の処理では添付ファイルの拡張子を決定するために画像の形式が必要となることから、引数 sTag を追加しています（関数側の修正については次回）。
② 既存のコンテンツ（=インラインイメージ）を削除
添付ファイルとして保存する Base64 の文字列は ① で取得しました。よって、リッチテキスト内のインラインイメージは不要になります。そこで、リッチテキストから完全に削除します。 DXL で言うと、以下の赤枠の部分を削除することになります。
関数は次の通りです。引数には、インラインイメージが存在する段落 par ノードを指定します。処理は単純で、配下のノードがなくなるまで、順に消去しているだけです。
Private Function xConvP2A_DelImage(vdenPar As NotesDOMElementNode) As Boolean
'配下ノード全削除で対応
Dim dn As NotesDOMNode
Set dn = vdenPar.FirstChild
While Not(dn Is Nothing)
If dn.IsNull Then
Set dn = Nothing
Else
Call vdenPar.RemoveChild(dn)
Set dn = vdenPar.FirstChild
End If
Wend
End Function
|
③ 添付ファイル（=実体に対する参照）を追加
削除した写真と同じ場所に添付ファイルを配置します。リッチテキスト内には、添付ファイルの実体ではなく、その参照（attachmentref ノード）を配置します。作成する DXL は下図のような構成となります。
この DXL を生成する関数は次の通りです。
Private Function xConvP2A_AddAttachRef(vddn As NotesDOMDocumentNode, vdenPar As NotesDOMElementNode, ByVal vsName As String) As Boolean
Dim den As NotesDOMElementNode
Dim dtn As NotesDOMTextNode
'attachmentref ノード
Dim denRef As NotesDOMElementNode
Set den = vddn.CreateElementNode("attachmentref")
Set denRef = vdenPar.Appendchild(den)
Call denRef.SetAttribute("displayname", vsName)
Call denRef.SetAttribute("name", vsName)
'picture ノード
Dim denPic As NotesDOMElementNode
Set den = vddn.CreateElementNode("picture")
Set denPic = denRef.Appendchild(den)
Call denPic.SetAttribute("align", "baseline")
Call denPic.SetAttribute("width", "76px")
Call denPic.SetAttribute("height", "96px")
'png ノード
Dim denPNG As NotesDOMElementNode
Set den = vddn.CreateElementNode("png")
Set denPNG = denPic.AppendChild(den)
'アイコン画像データ
Set dtn = vddn.CreateTextNode(xcsIconImage)
Call denPNG.AppendChild(dtn)
'caption
Dim denCap As NotesDOMElementNode
Set den = vddn.CreateElementNode("caption")
Set denCap = denPic.AppendChild(den)
Call denCap.SetAttribute("position", "below")
'caption 文字列
Set dtn = vddn.CreateTextNode(vsName)
Call denCap.AppendChild(dtn)
End Function
|
attachmentref ノードの役割として、リッチテキストに表示する添付ファイルアイコンの管理があります。今回は少し見栄えが良くなるよう、少し大きめの 76 x 96 ピクセルの PNG 画像をアイコンとします。アイコンの画像は、あらかじめ Base64 で変換し文字列定数 xcsIconImage に定義しています（後述）。
添付ファイルに表示されるファイル名は、画像の見出しと同じ機能を使用しています。上記関数では caption ノードを作成し、ファイル名をテキストノードにセット、見出しを ”イメージの下” に設定し、通常の添付ファイルと同等に表現しています。
④ 添付ファイルの実体を追加
添付ファイルは文書内で $FILE という特殊なフィールド内に格納されています。フィールドですので、ドキュメントノードに追加することとなります。作成する DXL は下図のようになります。
この処理を担当しているのが xConvP2A_AddAttach 関数です。
Private Function xConvP2A_AddAttach(vddn As NotesDOMDocumentNode, ByVal vsName As String, ByVal vsBase64 As String) As Boolean
Dim den As NotesDOMElementNode
Dim dtn As NotesDOMTextNode
'$FILE フィールドとして追加（=ドキュメントノードに追加）
Dim denDoc As NotesDOMElementNode
Set denDoc = vddn.DocumentElement
'item ノード
Dim denItem As NotesDOMElementNode
Set den = vddn.CreateElementNode("item")
Set denItem = denDoc.AppendChild(den)
Call denItem.SetAttribute("name", "$FILE")
Call denItem.SetAttribute("seal", "true")
Call denItem.SetAttribute("sign", "true")
Call denItem.SetAttribute("sealed", "false")
Call denItem.SetAttribute("summary", "true")
Call denItem.SetAttribute("placeholder", "false")
'object ノード
Dim denObj As NotesDOMElementNode
Set den = vddn.CreateElementNode("object")
Set denObj = denItem.AppendChild(den)
'file ノード
Dim denFile As NotesDOMElementNode
Set den = vddn.CreateElementNode("file")
Set denFile = denObj.AppendChild(den)
Call denFile.SetAttribute("name", vsName)
Call denFile.SetAttribute("flags", "storedindoc")
Call denFile.SetAttribute("encoding", "none")
Call denFile.SetAttribute("hosttype", "msdos")
Call denFile.SetAttribute("compression", "none")
'created ノード
Dim denDT As NotesDOMElementNode
Set den = vddn.CreateElementNode("created")
Set denDT = denFile.AppendChild(den)
Set den = vddn.CreateElementNode("datetime")
Set denDT = denDT.AppendChild(den)
Call denDT.SetAttribute("dst", "false")
Set dtn = vddn.CreateTextNode(xDateTime2ISO(Now))
Call denDT.AppendChild(dtn)
'modified ノード
Set den = vddn.CreateElementNode("modified")
Set denDT = denFile.AppendChild(den)
Set den = vddn.CreateElementNode("datetime")
Set denDT = denDT.AppendChild(den)
Call denDT.SetAttribute("dst", "false")
Set dtn = vddn.CreateTextNode(xDateTime2ISO(Now))
Call denDT.AppendChild(dtn)
'filedata ノード
Dim denData As NotesDOMElementNode
Set den = vddn.CreateElementNode("filedata")
Set denData = denFile.AppendChild(den)
'ファイルの実体
Set dtn = vddn.CreateTextNode(vsBase64)
Call denData.AppendChild(dtn)
End Function
|
⑤ 文書の保存（DXL 経由）
手順の最後は DXL 経由で文書を保存する関数です。今回はすでに存在する文書の更新しか行いませんので、専用の関数 xSaveDXL_Update を作成しました。
Private Function xSaveDXL_Update(vdprs As NotesDOMParser) As Boolean
Dim dimp As NotesDXLImporter
Dim nsOut As NotesStream
Dim nd As NotesDocument
Dim nrti As NotesRichTextItem
Set nsOut = xns.CreateStream()
Call vdprs.SetOutput(nsOut)
Call vdprs.Serialize()
On Error GoTo ErrProc
'Import時リッチテキストを引数にするのが一番安定
Set nd = xndb.CreateDocument
Set nrti = nd.CreateRichTextItem("Body")
Call nrti.AppendText(nsOut.ReadText)
Set dimp = xns.CreateDXLImporter()
dimp.DocumentImportOption = 5 '上書き保存
Call dimp.Import(nrti, xndb)
xSaveDXL_Update = True
ExitProc:
Exit Function
ErrProc:
xSaveDXL_Update = False
MsgBox Error$
Resume ExitProc
End Function
|
DocumentImportOption プロパティに 5 を指定している点がポイントですね。
関連関数
上記処理 ④ で添付ファイルの作成日（created ノード）と更新日（modified ノード）に現在時刻を指定している処理があります。DXL で日時を指定するためには、特別なフォーマット（ISO 8601）に変換する必要があります。このフォーマットについては過去の記事『DXL や JSON の日付値の変換』を参考にしてください。
今回は日時を文字列に変換する一方通行であること、例外処理は不要であることから、かなりの部分を固定化した単純な関数を作成しました。
Private Function xDateTime2ISO(vvDT As Variant) As String
xDateTime2ISO = Format(vvDT, "yyyymmdd") & "T" & Format(vvDT, "hhnnss") & ",00+09"
End Function
|
添付ファイルのアイコン画像
③ の処理でアイコン画像にセットしている文字列を定義します。以下の画像ファイルを Base64 に変換したもので、あまりに長いので適当な位置で改行しています。
以下の宣言をスクリプトライブラリ lsReadNameCard の (Declarations) に追加します。
'変換後のアイコン画像（PNG 形式 ＆ Base64 変換済み）
Private Const xcsIconImage = _
"iVBORw0KGgoAAAANSUhEUgAAAEwAAABgCAYAAAC3+ZRmAAAAAXNSR0IArs4c6QAAAARnQU1BAACx" & _
"jwv8YQUAAAAJcEhZcwAADsEAAA7BAbiRa+0AAAXySURBVHhe7ZqxbuNGFEXfBgkgsglAGW7EdBJs" & _
"F1IVgJVT5TeSD0i9CwRIkRQBAmzqfEDyG6kCAwGEdFZhG1JJNl57SpJFEOfe4ciWtJKsoUYAJc0B" & _
"ZJFvyVnq8r7heyTF4/F4PB7PCt6Y74+4urp6Mot7w8XFxRcnJyepWd0JawVLksSsNZ/hcKi/z87O" & _
"/j09Pf1Mr+yAT8z3QXB+fi53d3ef3t/f/2dCzjkowYgR7Q1EezAhpxycYMSI1oZo/5iQMw5SMGJE" & _
"+xKi3ZqQEw5WMGJEO/vw4cNbE9qagxaMULTb29tf4bQfTGgrDl4wYpz2M0T7zYRqcxSCESPadw8P" & _
"D1+bUC2ORjBC0W5ubv6E074yIWuOSjBinPYXLgTfmJAVRycYMReCP5Ce35rQxhylYMSk5+9Izx9N" & _
"aCOOVjBi0vMniPbehF7lqAUjRrR3mNO+N6G1HL1gxMxpv0C0dya0Ei+YwYj2Hun5twkt5eBuILrg" & _
"8vJypS4HI5grKPw6wXxKWuIFs8QLZokXzBIvmCVeMEu8YJZ4wSzxglniBbPEC2aJF8wSL5glXjBL" & _
"vGCWeMEs8YJZ4gWzxEowhc9wONa3cfnJxiNECh3PRmO9fOhYOyzCJ0l6MkgSSaUDFeu95T0aQ+Yi" & _
"M2v7Q+2UDPAJw0CKotTrOT4Ugc5TxnlknBWIjXS8yBjHdojlCk69Tp9jy7ZrIrUFoxx5XkgQtKoA" & _
"FOvHgXZeVsKHhdKpKmkqyaAjPToy5bZK+p1AwqiHeCxBp79yuyZiLRh/BuexazghFqRUFOt4GOJP" & _
"QN+9UEDVMIQDEWcql1G7Ci6w6XZNoPYcxmeWnV4fa/MiHTq1U3ITaLg8R3rBLXRmSz1+5EKy6XZN" & _
"YKeC0Y0Sx5jcMxkzhWNeIHQUORg8T/prt2sY/lWBBXiV9q8KOMQLZkktwfa1SneBtWD7XKW7wFqw" & _
"fa7SXbD1HLZPVboL/KRvydaC7VOV7oJ6gu1ple4CX+kv4Ct9x3jBLPGCWVJLMHZGI+T6LtojXmmb" & _
"/ATKWjD+jDLjrelICjVf0S/2mE3uOesem/VVEm2jyAT9YreL74l0+viWoOox02u9zSAOZSLduXUV" & _
"9SW9Zp+ZC1ax3wDLge5DVTrRcW5XoN16hMPKVoieNZVeFErU68LVqO0eR8JzhH+RFkoZlSq93Eeb" & _
"VgQdmUAE9rnT8RXG51j6tObqeawRdJoe2+JvdH6VzCEYzIXaNKgKVpM6iz3m4jpWcXB9fYBpq4fc" & _
"S6sfYvpQxrmdZskTKBKWObbrSquXSJhjPyxLPNBOh3bSkWxufA3GSrrtubFmj80Wa8HUI85b0NKl" & _
"qWLfyMp+A+jMIc42z6DABWS2D51l2RMoUj3Rq+LTv62Z7cYqnxufrBqrLlaC6fMMgYaw/vTApg9y" & _
"X0OpQgZRqR0QwhW7gCnN8flB7pmoW6wEoyNiOCJJBvqgIqRGkfOZ9+YwgfkAmPDET/tQFyg4rPof" & _
"doeVYPydQYsHVVkcLaUUJT1vDnKmx1xcj6JAsCgTODMsqzTWHafpQ+nYbW4+xhhMtTDW8Hqzkscc" & _
"my2+l1zA+VXy2PGCWeIFs8SJYKzy1RgT7RpYksy+vTgevUzM3H864fPyMWQpjpKF+zStr3QiGCtn" & _
"lhivwavi9M0f6Qwkm/AqVUgH+6eqetrEij0WxM1rVE3DSjD2q1Mn8ZyP6AS4pOpjR1U1b55PZnTQ" & _
"GmfEKDMUpGGrQiFLCJShqVfjMQRkxF117hIrwWbrLhTu+KFQKtDVlGZZv7gpXe2yCIUxxmyou4iV" & _
"YM+VOQRbLGLJsn5xU3gCeEeh6VgJRi9NG+4S7UzUfnEX2aZfTDF59aJcO7PIeLunmVhP+hQpe1TS" & _
"4o0pircEbRbTL64ihbgRJ3ekNJ0ZqQwXjh46JUR1JjfTbdaCsWdLy1jaLf6qeYct6xdnoQTT0kKy" & _
"a+l0OVdh8od4bbiL43EeVBHf/6/2TxFmf8h9tuk1XeF7yQV4Ynwv6RAvmCVrU9IsHh3rUnIlT09P" & _
"n5tFj8fj8XiOEZH/AW6rKKt4M8mjAAAAAElFTkSuQmCC"
|
次回の予告
ここまで対応するとスクリプトライブラリのエラーは次の 1 ヶ所となっているはずです。
今回の最初に記載した通り、作成済みの関数 xGetDXL_FirstInlineImage64 の引数 sTag が増えているからです。次回はこの関数の修正から作業を開始します。
Private Function xConvPhoto2Attach(rndNameCard As NotesDocument, ByVal vsFld As String) As Boolean
Dim sBase64 As String
Dim sID As String
Dim sTag As String
Dim sName As String
'名刺情報が保存された文書を取得（再取得）
sID = rndNameCard.Noteid
Set rndNameCard = Nothing '一旦文書開放
Set rndNameCard = xndb.GetDocumentByID(sID)
'Base64 イメージデータ取得
sBase64 = xGetDXL_FirstInlineImage64(rndNameCard, vsFld, sTag)
sName = "NameCard." & sTag 'ファイル名
'DXL の準備
|
