I have written the following agent for running through a database and extracting all attachments therein to a specified location on the hard drive and finally creating a consolidated excel sheet for the database for the remaining fields.
Having done this, I would like to re-attach the attachements which I had extracted earlier into the respective documents in the database. Is there any way it can be done? Would EmbedObject Method in NotesRichTextItem class be the way in?
Sub Initialize
Dim session As New NotesSession
Dim db As NotesDatabase
Dim view As NotesView
Dim xlview As NotesView
Dim configview As NotesView
Dim doc As NotesDocument
Dim xldoc As NotesDocument
Dim configdoc As NotesDocument
Dim rtitem As Variant
Dim filecount As Integer
Dim textitem As NotesItem
Dim xlApp As Variant
Dim xlSheet As Variant
Dim rowCount As Integer
Const MAX = 10000000
Set db= session.CurrentDatabase
Set view = db.GetView("($All)")
Set doc = view.GetFirstDocument
'Extracting the attachments if any in the document
While Not doc Is Nothing
Set rtitem = doc.GetFirstItem("Body")
filecount = 0
If rtitem.Type = RICHTEXT Then
bodyitem= rtitem.Abstract(10000, False, False)
Set textitem = New NotesItem(doc, "BodyAbstract", bodyitem)
If doc.HasEmbedded = True Then
Forall o In rtitem.EmbeddedObjects
If (o.type=EMBED_ATTACHMENT) And (o.Filesize < MAX) Then
filecount = filecount + 1
Call o.ExtractFile ("C:\" & db.Title & "\" & Strleft(doc.Subject(0), "/") & "_" & filecount & "-" & o.Name)
Call o.Remove
End If
End Forall
End If
Call doc.Save(True, True)
End If
Set doc = view.GetNextDocument(doc)
Wend
'Code to prepare a consolidated Excel sheet with data from the fields minus the OLE attachments
Set xlview = db.GetView("($All)")
Set xldoc = xlview.GetFirstDocument
Set xlApp = CreateObject( "Excel.Application" )
xlApp.Visible = False
xlApp.workbooks.add
Set xlSheet = xlApp.workbooks(1).worksheets(1)
rowcount=1
xlSheet.Cells(rowCount,1).Value="Subject"
xlSheet.Cells(rowCount,2).Value="Date"
xlSheet.Cells(rowCount,3).Value="Author"
xlSheet.Cells(rowCount,4).Value="Description"
While Not xldoc Is Nothing
rowCount=rowCount+1
xlSheet.Cells(rowCount,1).Value=xldoc.Subject(0)
xlSheet.Cells(rowCount,2).Value=Format(xldoc.OriginalModTime(0), "dd/mm/yyyy")
nameuser = Strright(Strleft(xldoc.From(0), "/"), "CN=")
xlSheet.Cells(rowCount,3).Value= nameuser
xlSheet.Cells(rowCount,4).Value= xldoc.BodyAbstract(0)
Set xldoc=View.GetNextDocument(xldoc)
Wend
xlApp.ActiveWorkbook.SaveAs "C:\" & db.Title & "\" & db.Title & ".xls"
xlApp.ActiveWorkbook.Close
xlApp.Quit
End Sub