Notes文档中附件批量导出到本地系统

Type BROWSEINFO 
 hOwner As Long 
 pidlRoot As Long 
 pszDisplayName As String 
 lpszTitle As String 
 ulFlags As Long 
 lpfn As Long 
 lParam As Long 
 iImage As Long 
 End Type 


 Const BIF_RETURNONLYFSDIRS = &H1 
 Const BIF_DONTGOBELOWDOMAIN = &H2 
 Const BIF_STATUSTEXT = &H4 
 Const BIF_RETURNFSANCESTORS = &H8 
 Const BIF_BROWSEFORCOMPUTER = &H1000 
 Const BIF_BROWSEFORPRINTER = &H2000 
 Const MAX_PATH = 260 


 Declare Function SHGetPathFromIDList Lib "shell32" Alias "SHGetPathFromIDListA" 
     (ByVal pidl As Long, ByVal pszPath As String) As Long 
 Declare Function SHBrowseForFolder Lib "shell32" Alias "SHBrowseForFolderA" 
     (lpBrowseInfo As BROWSEINFO) As Long 
 Declare Sub CoTaskMemFree Lib "ole32" (ByVal pv As Long) 
 Declare Function GetDesktopWindow Lib "user32" () As Long 




 Sub Initialize() 
   
 Dim session As New NotesSession 
 Dim db As NotesDatabase 
 Dim collection As NotesDocumentCollection 
 Dim doc As NotesDocument   
 Dim rtitem As Variant 
 Dim NotesItem As NotesItem 
   
 Dim bi As BROWSEINFO 
 Dim pidl As Long 
 Dim path As String 
 Dim pos As Integer 
   
 bi.hOwner = GetDesktopWindow() 
 bi.pidlRoot = 0& 
 bi.lpszTitle = "Select directory to save the attachments"
 bi.ulFlags = BIF_RETURNONLYFSDIRS 
 pidl = SHBrowseForFolder(bi) 
 path = Space$(MAX_PATH) 


 If SHGetPathFromIDList(ByVal pidl, ByVal path) Then 
 pos = InStr(path, Chr$(0)) 
 End If 


 Call CoTaskMemFree(pidl) 


   Set db = session.CurrentDatabase 
   Set collection = db.UnprocessedDocuments 
   Set doc = collection.GetFirstDocument() 
   
 While Not(doc Is Nothing)   
     // 此处假定附件是嵌入在 Body 域当中，当然也可以循环文档所有的域，然后对于富文本域进行处理，提取附件      
     Set rtitem = doc.GetFirstItem( "Body" ) 
     If ( rtitem.Type = RICHTEXT ) Then 
          ForAll o In rtitem.EmbeddedObjects                     
            If ( o.Type = EMBED_ATTACHMENT ) Then     
              Call o.ExtractFile( Left(path, pos - 1) & "\" & o.Name  ) 
          End If         
          End ForAll 
     End If 
    Set doc = collection.GetNextDocument(doc) 
   Wend 


 End Sub