导出选定文档中的指定的域中的所有附件

这里假定：域“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