導出選定文檔中的指定的域中的所有附件

這裏假定：域“bt4”爲存放附件的域。可以循環判斷當前文檔中所有的域中是否包含附件,也可以提供一個輸入框讓用戶指定存放附件的域。這裏不再深入討論。
Sub Initialize
Dim session As New NotesSession
Dim ws As New NotesUIWorkspace
Dim db As NotesDatabase
Dim dc As NotesDocumentCollection
Dim doc As NotesDocument
Dim rtitem As Variant
Dim strMainPath As Variant,strSubPath As String
Dim docCount As Integer

Set db=session.CurrentDatabase
Set dc=db.UnprocessedDocuments
Set doc=dc.GetFirstDocument
strMainPath = ws.SaveFileDialog(True,"批量導出文件")        
'SaveFileDialog這個方法，第一個參數爲True，表示只返回選定的文件夾，如果爲False，則返回指定的文件，詳細說明參見幫助。該方法返回值爲數組。
If Isempty(strMainPath) Then
  Messagebox("未提供保存路徑")
  Exit Sub
End If
If Right(strMainPath(0),1)<>"\" Then
  strMainPath(0)=strMainPath(0) & "\"
End If
docCount=1
Do Until doc Is Nothing
  Set rtitem=doc.GetFirstItem("bt4")
  If rtitem.Type = RICHTEXT Then
   strSubPath="第" & Cstr(docCount) & "個文檔的文件"
   Mkdir strMainPath(0) & strSubPath & "\"                                        
'這裏建立子文件夾，以防止同名文件保存衝突。當然，同一個文檔中的附件名稱也可能一樣，可以繼續深入判斷當前文件夾中是否已經有同名文件，如果有的話，需要更改名稱保存。這裏不再深入討論。
   Forall o In rtitem.EmbeddedObjects
    If o.Type = EMBED_ATTACHMENT Then
     Call o.ExtractFile ( strMainPath(0) & strSubPath & "\" & o.Name )
    End If
   End Forall
  End If
  Set doc=dc.GetNextDocument(doc)
  docCount=docCount+1
 Loop
End Sub