Batch export of attachments in Lotus Notes database

Public Class Getallnotesemobject
‘-------------------------------------------------------------------
' ****** feature: a class that can extract rich text field attachments directly from a document in a view *******
‘-------------------------------------------------------------------
Private FileNum as Integer
Private folder as String
Private Rtffield as String
Private FileType as String
Public Doc as NotesDocument
' Private Writestr as String
' ============= Set folder path ==============
Sub Setfolder (f as String)
Folder=f
End Sub
' ============= set the RTF domain name ===============
Sub setrtffieldname (RF as String)
Rtffield=rf
End Sub
' ============= settings doc===============
Sub Setdoc (document as Variant)
Set doc=document
End Sub
Sub GetObject (wStr1 as String)
‘------------------------------
' Usage: getObject (Domain A)
' Note: Domain A is a sub-folder for different files, note that each document's a must be different in order not to overwrite
‘------------------------------
Dim s as New notessession
Dim DB as NotesDatabase

Dim Eobject as Notesembeddedobject
Dim Rtfitem as Variant
Dim item1,item2 as Notesitem
Dim Tempname as String
Dim Exportname as String
Dim Exportlastname as String
Dim I,j,k, M as Integer
Filenum=freefile ()
K=0 ' to record the number of errors
M=1 ' is used to record the number of files with the same name, default is 1
Set db=s.getdatabase ("D23dbl35", "Dbom\caiyi\chinao1.nsf")

If folder= "then Exit Sub
On Error Resume Next
' Create directory directly
Mkdir folder

Set Item1=doc.getfirstitem (WSTR1) ' Sub-folder
Writestr=item1.values (0)
Print "Extracting attachments from [" +writestr+ "]
Domain Name of Set rtfitem=doc.getfirstitem (rtffield) ' Rtffield:rtf domain
J=0
Mkdir folder+ "\" +writestr
Forall ob in Rtfitem. EmbeddedObjects
' =========2005/07/07=============
' Modify to detach directly from the name of the attachment
Ob. Extractfile (folder+ "\" +writestr+ "\" +ob.name)
exportname=folder+ "\" +writestr+ "\" +ob.name

If Exportname=exportlastname Then
M=m+1
Ob. Extractfile (Left (Exportname,len (exportname)-4) + "(" +cstr (m) + ")" +right (ob.name,4))
Else
M=1
Ob. Extractfile (Exportname)
End If

Exportlastname=exportname

End Forall
' ========== write error log ===============
If err=92 Then
Open folder+ "\faillog" +cstr (today) + ". txt" for Output as FileNum
Write #filenum%,writestr+ "No Attachments" +newline
K=1
End If
' ===============================
Err=0

Close FileNum
If K=1 Then
k= "section has errors, see the folder Faillog" +cstr (today) + ". TXT record "
Else
K= ""
End If
Print "Extraction complete! Please find it in the "+folder+" folder. "+k

End Sub
End Class


Sub Initialize
Dim s as New notessession
Dim DB as NotesDatabase
Dim Doccol as Notesdocumentcollection
Dim Doc as NotesDocument
Dim folder as String
Set db=s.getdatabase ("D23dbl35", "Dbom\caiyi\chinao1.nsf")
folder=inputbox$ ("Please fill in the save path, such as C:\TEMP or C:", "System Prompt", "C:\Temp")
If Trim (folder) = "Then
Msgbox "Save path is wrong, please rerun program", 16+64, "System Prompt"
Else
Set doccol=db. AllDocuments ' This method can only be used by the agent to function properly.
If Doccol.count>0 Then
Set Doc=doccol. Getfirstdocument ()
For I=1 to Doccol.count
Dim Ntoe as New getallnotesemobject ' Instantiate custom Extract attachment class
Ntoe.setrtffieldname ("Body") ' Definition Attachment Rich text field
Ntoe.setfolder (folder) ' Define save path '
Set Ntoe.doc=doc ' defines the doc to extract attachments
Ntoe.getobject ("Ocrm") ' extracting an attachment method using a custom class
Set ntoe=nothing ' free memory

Set Doc=doccol.getnextdocument (DOC)

Next
End If
End If
End Sub

To build one more operation, write on:
@Command ([Toolsrunmacro]; " Getemobject ")
You can then use this key in the view to download the attachment directly from the view.

Source: http://zwm136200.blog.163.com/blog/static/428967962011110114926539/

Batch export of attachments in Lotus Notes database