notes

Sub UpdateAttachment()
Dim session As New NotesSession
Dim db As NotesDatabase
Dim doc As NotesDocument
Dim rtitem As NotesRichTextItem
Dim embObj As NotesEmbeddedObject

' 対象のDBを開く
Set db = session.CurrentDatabase

' 文書Aを取得（適切な条件で取得する）
Set doc = db.GetDocumentByUNID("xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx") ' 文書AのUNIDに置き換える
If doc Is Nothing Then
    MsgBox "対象の文書が見つかりません。", 16, "エラー"
    Exit Sub
End If

' リッチテキストフィールド「RT」を取得
If doc.HasItem("RT") Then
    Set rtitem = doc.GetFirstItem("RT")
    If rtitem.Type = RICHTEXT Then
        ' 既存の添付ファイルを削除
        Forall obj In rtitem.EmbeddedObjects
            If obj.Type = EMBED_ATTACHMENT Then
                Call obj.Remove
            End If
        End Forall
    End If
Else
    ' フィールドがない場合、新規作成
    Set rtitem = New NotesRichTextItem(doc, "RT")
End If

' 新しいファイルを添付
Set embObj = rtitem.EmbedObject(EMBED_ATTACHMENT, "", "c:\temp\CCC.xlsx")

' 文書を保存
Call doc.Save(True, False)

MsgBox "添付ファイルを更新しました。", 64, "完了"

End Sub