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
Else
' 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")
Wend
Else
' 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
errorHandler:
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
You renamed your function before posting it from ExtractFileNames to ExtractFiles but there are still references to the former name.
ReplyDeleteHence the function doesn't compile.
Consider updating the code ;)
It is done. Thanks for spotting it out :)
ReplyDelete