在工作中,经常要将notes库中的附件导出成为本地文件,如word文件.
在nsf的视图中,创建一个操作,在onclick中,加lotus script
Sub Click(Source As Button)
On Error Resume Next
Dim session As New NotesSession
Dim db As NotesDatabase
Dim doc As NotesDocument
Dim dc As notesdocumentcollection
Dim rtitem As NotesRichTextItem
Dim sFileName As String
Set db = session.CurrentDatabase
Set dc=db.unprocesseddocuments
Set doc=dc.getfirstdocument '得到选定文档的位置
If doc Is Nothing Then
Messagebox "没有选择任何文件,请必须选择一个文件",16,"提示消息"
Exit Sub
End If
For i=1 To dc.count
Set doc=dc.GetNthDocument(i)
If (doc.HasEmbedded) Then
Forall o In doc.EmbeddedObjects
Set handle= o.activate(False)
Dim fn As Variant
fn = doc.GetItemValue("d_FileNo")
sFileName = Replace(fn(0),"/","")
If sFileName<>"" Then
handle.saveas( "D:\Notes数据迁移\doc\" & sFileName & ".doc" )
handle.close
End If
End Forall
End If
Next
Messagebox "导出成功!"
Exit Sub
'errHandler:
' Msgbox ("errorMsg:" + sFileName + Error$ + "(" & Erl & ")")
' Goto NextLabel
End Sub
复制进去,修改下路径就可以了
在nsf的视图中,创建一个操作,在onclick中,加lotus script
Sub Click(Source As Button)
On Error Resume Next
Dim session As New NotesSession
Dim db As NotesDatabase
Dim doc As NotesDocument
Dim dc As notesdocumentcollection
Dim rtitem As NotesRichTextItem
Dim sFileName As String
Set db = session.CurrentDatabase
Set dc=db.unprocesseddocuments
Set doc=dc.getfirstdocument '得到选定文档的位置
If doc Is Nothing Then
Messagebox "没有选择任何文件,请必须选择一个文件",16,"提示消息"
Exit Sub
End If
For i=1 To dc.count
Set doc=dc.GetNthDocument(i)
If (doc.HasEmbedded) Then
Forall o In doc.EmbeddedObjects
Set handle= o.activate(False)
Dim fn As Variant
fn = doc.GetItemValue("d_FileNo")
sFileName = Replace(fn(0),"/","")
If sFileName<>"" Then
handle.saveas( "D:\Notes数据迁移\doc\" & sFileName & ".doc" )
handle.close
End If
End Forall
End If
Next
Messagebox "导出成功!"
Exit Sub
'errHandler:
' Msgbox ("errorMsg:" + sFileName + Error$ + "(" & Erl & ")")
' Goto NextLabel
End Sub
复制进去,修改下路径就可以了