作成者	カテゴリ	返答の対象		公開
すなっぴ 12/01/2005 06:40 PM		リッチテキストフィールドのコピーが出来ません

アドバイスを頂いてから、試行錯誤してやっと完成しました！
ヾ(⌒▽⌒ )ノ彡☆
貴重なアドバイス、本当にありがとうございました。
道が開けました。
何かありましたら、よろしくお願いします。

以下、スクリプトです。

Sub Click(Source As Button)

On Error Goto label1

'現在の文書を取得
Dim w As New NotesUIWorkspace
Dim s As New NotesSession
Dim uidoc As NotesUIDocument
Dim db As NotesDatabase
Dim doc As NotesDocument
Dim iniview As NotesView
Dim inidoc As NotesDocument
Dim bunid As String

Dim rtitemA As NotesRichTextItem
Dim rtitemB As NotesRichTextItem

Set db = s.CurrentDatabase '現在のDB取得
Set uidoc=w.CurrentDocument '現在の文書取得
Set doc=uidoc.Document

bunid=doc.UniversalID '処理後再度文書を開くため、文書IDをセット

'コピー先をクリア
Call doc.RemoveItem( "RichFirld_A" )
doc.SaveOptions = "0"
Call doc.save(True,True,True)

Set iniview= db.GetView( "DocumentView") 'コピー元のView
Set inidoc = iniview.GetFirstDocument 'コピー元の文書読み込み
Set rtitemA = inidoc.GetFirstItem("RichFirld_A") 'コピー元アイテム代入
Set rtitemB = rtitemA.CopyItemtoDocument( doc, "RichFirld_B" )'コピー元アイテムをコピー先へ代入

'強制Save
doc.SaveOptions = "0"
Call doc.save(True,True,True)

Print("終了しました。")

'処理が完了したので文書を閉じる
Call uidoc.Close

'結果を見るために文書を開く
Set doc=db.GetDocumentByUNID( bunid)
'編集Modeで文書開く
Set uidoc= w.EditDocument( True,doc)

Exit Sub

label1:
Messagebox "Error " & Err() & ": " & Error()
Exit Sub
End Sub