请问在Lotus notes中,如何批量保存文档中多个文本域中的附件

natsuki 2015-08-17 12:37:03
我用了以下的代码可以批量保存多个文档中一个文本域的附件,比如htwj,如果要保存多个文本域的附件,比如htwj_1和htwj_2,该如何写呢。请大神指点,谢谢!

Sub Initialize()

Dim session As New NotesSession
Dim db As NotesDatabase
Dim collection As NotesDocumentCollection
Dim doc As NotesDocument
Dim rtitem As Variant
Dim s As Variant
Dim NotesItem As NotesItem

Dim bi As BROWSEINFO
Dim pidl As Long
Dim path As String
Dim pos As Integer

'Fill the BROWSEINFO structure with the
'needed data. To accomodate comments, the
'With/End With sytax has not been used, though
'it should be your 'final' version.

'hwnd of the window that receives messages
'from the call. Can be your application
'or the handle from GetDesktopWindow().
bi.hOwner = GetDesktopWindow()

'Pointer to the item identifier list specifying
'the location of the "root" folder to browse from.
'If NULL, the desktop folder is used.
bi.pidlRoot = 0&

'message to be displayed in the Browse dialog
bi.lpszTitle = "Select your Directory"

'the type of folder to return.
bi.ulFlags = BIF_RETURNONLYFSDIRS

'show the browse for folders dialog
pidl = SHBrowseForFolder(bi)

'the dialog has closed, so parse & display the
'user's returned folder selection contained in pidl
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)
Set rtitem = doc.GetFirstItem( "htwj" ) '附件字段域名为htwj
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
...全文
2602 回复 打赏 收藏 转发到动态 举报
写回复
用AI写文章
回复
切换为时间正序
请发表友善的回复…
发表回复

535

社区成员

发帖
与我相关
我的任务
社区描述
企业开发 Exchange Server
社区管理员
  • 消息协作社区
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧