domino 中關於附件的部分確實很傷，noteitem對象中貌似沒有關於java文件流的處理，只好採用折中的方法，先拆分，後上傳，估計IO夠嗆。
Sub Initialize
Dim session As New NotesSession
Dim db As NotesDatabase
Dim doc As NotesDocument
Dim dc As NotesDocumentCollection
Dim rtitem As NotesRichTextItem
Dim object As NotesEmbeddedObject
Dim fileCount As Integer
Const MAX = 100000
fileCount = 0
Set db = session.Currentdatabase
Set dc= db.Unprocesseddocuments()
Set doc = dc.Getfirstdocument()
'''''''''''''''''''''''''''''
If Not attdoc Is Nothing Then
Dim rtitem As NotesRichTextItem
Dim obj As NotesEmbeddedObject
Dim fileCount As Integer
filecount=0
tt=Evaluate("@AttachmentNames",attdoc)
For j=0 To UBound(tt)
Set obj=attdoc.Getattachment(tt(j))
If Not obj Is Nothing Then
obj.Extractfile("d:\fw\"+obj.Name)
End If
Next
End If
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
%REM
步驟一： 先將選中的文檔的附件進行拆分，放入指定位置
%END REM
Set rtitem = doc.Getfirstitem("attachement")
If ( rtitem.Type = RICHTEXT ) Then
ForAll o In rtitem.EmbeddedObjects
If ( o.Type = EMBED_ATTACHMENT ) _
And ( o.FileSize > MAX ) Then
fileCount = fileCount + 1
Call o.ExtractFile _
( "c:\newfile" & CStr(fileCount) )
Call doc.Save( True, True )
End If
End ForAll
End If
%REM
步驟二：新建文檔，並上傳附件
%END REM
Set doc = New NotesDocument( db )
Set rtitem = New NotesRichTextItem(doc, "attachement" )
While(fileCount)
Set object = rtitem.EmbedObject(EMBED_OBJECT, "", "c:\newfile" & CStr(fileCount))
fileCount = fileCount - 1
Wend
doc.Form = "Attachement"
doc.Subject ="Here's Jim's document, as an embedded object"
Call doc.Save( True, True )
end sub