Exporting Notes Documents
Thomas Hampel
2 October 2012A customer wanted to have all attachments of some selected Notes document exported to the file system and also wanted to keep an option for developers to access the metadata of the original Notes document.
Nothing easier than that, so I wrote this small script to get the job done.
First the entire document is exported into DXL, then all attachments are detached to the file system. Both parts are not rocket science, but some people might want to reuse the code.
To avoid name conflicts while detaching files a folder is created for each Notes document so all attachments of this Notes document will be stored in this subfolder.
Option Public
Option Declare
Dim gCounter&
Sub Initialize
Dim s As New NotesSession
Dim coll As NotesDocumentCollection
Dim BasePath$
BasePath$ = InputBox ("Export data to path...: ", "Export", "C:\")
'# add backslash at the end
If right (BasePath$,1) <> "\" Then BasePath$ = BasePath$ & "\"
Print "Using BasePath : " & BasePath$
Set coll = s.currentdatabase.Unprocesseddocuments
If coll Is Nothing Then
MessageBox "No documents selected"
Else
Print "Processing " & coll.count & " documents..."
Call ExportToDXL (coll, BasePath$)
Call ExportToFile (coll, BasePath$)
MessageBox "Export completed."
End If
End Sub
Function ExportToDXL (Coll As NotesDocumentCollection, BasePath As String)
Dim session As New NotesSession
Dim stream As NotesStream
Dim DXLfilename$
Dim doc As NotesDocument
Dim tdoc As NotesDocument
Dim exporter As NotesDXLExporter
If coll Is Nothing Then Exit function
Set doc = coll.getfirstdocument
While Not doc Is Nothing
Set tdoc = coll.getNextDocument (doc)
'# Open xml file named after current database
Set stream = session.CreateStream
DXLfilename$ = BasePath$ & doc.universalid & ".dxl"
If Not stream.Open(DXLfilename$) Then
MessageBox "Cannot open " & DXLfilename$,, "Error"
Exit Function
End If
'# kick off the exporter process
Set exporter = session.CreateDXLExporter
Call exporter.SetInput(doc)
Call exporter.SetOutput(stream)
Call exporter.Process
Set doc = tdoc
Wend
End Function
Function ExportToFile (coll As NotesDocumentCollection, BasePath As String)
On Error GoTo ErrH
Dim doc As NotesDocument
Dim tdoc As NotesDocument
Dim rtitem As variant
Dim targetpath$, fname$
Dim FieldList(0) As String
Dim oba As Variant
'# define which fields to scan for attachments
FieldList (0) = "Body"
If coll Is Nothing Then Exit Function
Set doc = coll.getfirstdocument
While Not doc Is Nothing
Set tdoc = coll.getNextDocument (doc)
If doc.Hasembedded Then
targetpath$ = BasePath$ & doc.universalid & "\"
If Dir$ (BasePath$ & doc.universalid, 16) = "" Then MkDir targetpath$
'# loop list of fields
ForAll f In FieldList
Set rtitem = doc.GetFirstItem(f)
If Not rtitem Is Nothing Then
If (rtitem.Type = RICHTEXT ) Then
'# make sure the field contains some objects and detach
If IsArray(rtitem.embeddedObjects) Then
ForAll o In rtitem.EmbeddedObjects
If ( o.Type = EMBED_ATTACHMENT ) Then
Fname$=o.Name
If FileExists (fname$) Then fname$ = CStr(gCounter&) & Fname$
Call o.ExtractFile(targetPath$ & Fname$)
gCounter& = gCounter& + 1
End If
End ForAll
End If
End If
End If
End ForAll
End If
Set doc = tdoc
Wend
continue:
Exit Function
errH:
Stop
Print "Error " & Err() & " in line " & Erl() & " - " & Error
Resume continue
End Function