Friday, March 25, 2011

Lotus Script Function to extract all attachements from a Notes Document

Function ExtractFiles (doc As NotesDocument , filePath As String , extract As Boolean) As String
'handle errors in case of abrupt termination
    On Error Goto errorHandler
    'declare all the objects and variables necessary for further manipulation
    Dim rtitem As NotesRichTextItem
    Dim allFileName As String
    Dim attname As String
    Dim path As String
    Dim dirCreated As Boolean
    Dim tempDoc As NotesDocument
    Dim session As New NotesSession
    Set tempDoc  = New NotesDocument(session.CurrentDatabase)
    Call doc.CopyAllItems(tempDoc)
    Call tempDoc.Save(True,False)
    allFileName =""
    dirCreated = False
    Set rtitem = tempDoc.GetFirstItem( "Body")
    'Mantis Issue: 7106 Type Mismatch Error Logged in LNCNSFlog.txt File During Export of Message
    'the following check will verify whether the document has en embedded object
    If ( tempDoc.HasEmbedded ) Then  ' code added by Rajesh Kumar
        While Not rtitem Is Nothing
            Forall eo In rtitem.EmbeddedObjects
                If (eo.Type = EMBED_ATTACHMENT) Then
                    ' If Name and Source are different, Name is a random name assigned by Domino...
                    If eo.Name <> eo.Source Then
                          ' take advantage of the random Name & add extension of the Source...
                        Call LogWrite ("ExtractFileNames - --Name = " + eo.Name + " Source = " + eo.source)
                        allFileName = allFileName + "~~##~~" + eo.source + "||" + eo.Name
                        attname = eo.source + "-~~##~~-" + eo.Name
                          ' No random name was assigned, so it is safe to use Source...
                        allFileName = allFileName + "~~##~~" + eo.source
                        attname = eo.source
                        Call LogWrite ("ExtractFileNames - Extracting ------" + attname)
                        Call LogWrite ("ExtractFileNames - --Source Only= " + eo.Source)
                    End If
                    If (extract) Then
                    'if the directory is created then
                        If (Not dirCreated ) Then
                            path = filePath + Cstr(doc.NoteID)
                            Call LogWrite ("ExtractFileNames - The path is Extract File Names : "+ path)
                        'create a directory
                            Mkdir ( path )
                        'set the value to true
                            dirCreated = True
                        End If
                        Call LogWrite ("ExtractFileNames - Extracting to path : " + path + "\" + attname)
                        Call eo.ExtractFile( path + "\" + attname)
                    End If
                End If
            End Forall
        'remove the current attachment
            Call rtitem.Remove
        'get the handle to the next document which is the first document ,since the previous doc is removed
            Set rtitem = tempDoc.GetFirstItem( "Body")
          ' code added by Rajesh Kumar
        Call LogWrite ("ExtractFileNames - No Attachment found in the Document")
    End If
    ExtractFiles = allFileName
    Call tempDoc.Remove ( True)
    Call LogWrite ("ExtractFileNames - Exiting the function")
    Exit Function
'log the error that resulted in abrupt termination       
    Call LogWrite ("ExtractFileNames - Exiting the function Got error  for doc :" & Cstr(doc.UniversalID) & "   " & Error$ & " on line " & Cstr(Erl))
    ExtractFiles = allFileName
    If Not tempDoc Is  Nothing Then
        Call tempDoc.Remove ( True)
    End If
    Exit Function
End Function


  1. You renamed your function before posting it from ExtractFileNames to ExtractFiles but there are still references to the former name.
    Hence the function doesn't compile.

    Consider updating the code ;)

  2. It is done. Thanks for spotting it out :)