Lotus Notes Lotus Script

Sub OutPutLink

Dim rtf As NotesRichTextItem
Dim session As New NotesSession
Dim db As NotesDatabase
Dim doc As NotesDocument
Set db = session.CurrentDatabase
Set doccol=db.AllDocuments '此方法仅能用于代理方能正常运行。
Set doc = doccol.GetFirstDocument()
flg=False
If doccol.count>0 Then
Set doc=doccol.Getfirstdocument()
For i=1 To doccol.count
On Error Resume Next
Set rti=doc.GetFirstItem("Body")
Set rtf=doc.GetFirstItem("Body")
Set rtnav=rti.CreateNavigator
Set rtlink = rtnav.getfirstelement(RTELEM_TYPE_DOCLINK)
flg=True
While (flg)
If Not rtlink Is Nothing Then
Call rtf.BeginInsert(rtnav)
Call rtf.AppendText(rtlink.Docunid)
Call rtf.EndInsert
Set rtlink = rtnav.getnextelement
Else
flg=False
End If
Wend

Call doc.Save(True,True)
Set doc=doccol.getnextdocument(doc)
Next
End If
Print "提取完毕！"

End Sub

Sub OutPutFile

Dim session As New NotesSession
Dim db As NotesDatabase
Dim doc As NotesDocument
Dim rtitem As Variant
Dim NotesItem As NotesItem
Dim link As NotesRichTextDoclink
Dim flg As Boolean
Dim folderName As String
Dim id As String
Dim fileCount As Integer
fileCount=0
Dim subFolder As String
Set db = session.CurrentDatabase
Set doccol=db.AllDocuments '此方法仅能用于代理方能正常运行。
Set doc = doccol.GetFirstDocument()
flg=False

If doccol.count>0 Then

Set doc=doccol.Getfirstdocument()

For i=1 To doccol.count

Set rtitem = doc.GetFirstItem( "Body" )

Set rtf = doc.GetFirstItem( "Body" )

id=doc.UniversalID

folderName = "C:\temp" & "" & id

On Error Resume Next

fileCount=0

If Dir$(folderName,16)="" Then
Mkdir folderName
End If

Forall o In rtitem.EmbeddedObjects
If ( o.Type = EMBED_ATTACHMENT ) Then
subFolder = folderName & "" & fileCount
If Dir$(subFolder,16)="" Then
Mkdir subFolder
End If

Set obj=o

If Not obj Is Nothing Then
Call rtf.BeginInsert(obj)
Call rtf.AppendText("$$" & obj.Name & "$$")
Call rtf.EndInsert
End If

Call o.ExtractFile(subFolder & "" & o.Name)
fileCount=fileCount+1
End If
End Forall

Dim attachName As Variant

Dim attachObj As NotesEmbeddedObject

attachName=Evaluate(|@AttachmentNames|,doc)

Forall item In attachName
Set attachObj= doc.GetAttachment(item)
If Not attachObj Is Nothing Then
subFolder = folderName & "" & fileCount
If Dir$(subFolder,16)="" Then
Mkdir subFolder
End If
Call attachObj.ExtractFile(subFolder & "" & item)
fileCount=fileCount+1
End If
End Forall

Set doc=doccol.getnextdocument(doc)
Next
End If
Print "提取完毕！"
End Sub