Personal Blog of Thomas Hampel - Creative Mythbusting in Development and Collaboration

Previous Document Next Document

Exporting Notes Documents

Thomas Hampel
 2 October 2012

A 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
Tagged with: Code Development Domino
Comments
No Comments Found
Go ElsewhereSubscribe to RSSAboutStay ConnectedAnd More
Thomas Hampel, All rights reserved.