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

迷南。 2022-10-02 03:55 125阅读 0赞

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

转载于:https://blog.51cto.com/sysmw/427224