多 Notes 文档中附件批量导出到本地系统代码,Domino代码库,德仔网

代码语言

代码分类

【Domino】多 Notes 文档中附件批量导出到本地系统

作者:知文 / 发布于2016/8/5/ 859

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

试试其它关键字

同语言下

可能有用的

知文贡献的其它代码(19)