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
Comments
1.) Exporting Notes Documents
Michael Schaefer 29/07/2021 15:11:10
VERY USEFUL. Till now I did not know so much about DXL.
In above code I miss the code for function FileExists which could look like this
Function FileExists(filenm As String) As Boolean
' Tests if file exists, returns True for yes, False for no
On Error GoTo FErrorHandler 'Bail on an error
'Test file
If (Dir$(filenm)="") Then
'No file exists
FileExists = False
Else
'File exists
FileExists = True
End If
Exit Function
FErrorHandler:
'We had an error, so we assume there was no file found
FileExists = False
Exit Function
End Function
The code I found at "http://techblog.klingonheart.com/2012/03/lotus-script-file-exists-function.html"