Adding name of detached file to the end of an email

I'm using Lotus Notes 6.5 and need to detach the attachments from a huge number of files because we are moving to Outlook with small quotas and no archiving.

I found some code for an Agent on this site that does this very well but something is missing.  I would like to append the name of the detached file(s) to the end of the email.

Current code from Bill-Hanson posted here

Any help greatly appreciated.
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Ah, the joys of migrating to Exchange...

Sorry for your loss.
Just before the save in the code from B-H you add something like ( untested )
dim rtitem as richtextitem
set rtitem  = doc.getfirstitem("body")
call rtitem.appendtext("the names of the attachments you removed")

you may need a small loop through the attachments file names to add one by one.

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Simon-sezAuthor Commented:

That almost works, I had to change the Dim statement to the following and then just insert the other two lines into the filename loop.
dim rtitem as NOTESrichtextitem

However, the set statement fails with emails that have no text, i.e. just an email with a subject and an attachment.  The error is "Object variable not set".  So I need a way to detect if the body is empty and create it in that case.
Fundamentals of JavaScript

Learn the fundamentals of the popular programming language JavaScript so that you can explore the realm of web development.

Sjef BosmanGroupware ConsultantCommented:
Enclose the statements in the loop in

If Not rtitem Is Nothing Then
End If
Simon-sezAuthor Commented:
Small correction, the error occurs on the call rtitem.appendtext line not the set.
Simon-sezAuthor Commented:
@sjef bosman
Thanks, that catches the error.  Being a lotus script newb I tried 'is null' not 'is nothing' on my attempts.

Sorry if the questions seem simple but this is my first attempt with lotus script and probably my last as it's being replaced.

The last piece is therefore to create an email body text where one doesn't exist so I can add the detached file info.

I'm guessing it's something like call rtitem.create .... - I'll be looking and trying things but will keep checking here as well.
Simon-sezAuthor Commented:
replaced at my work that is :)
Simon-sezAuthor Commented:
I think I've got it using

set rtitem = new notesrichtextitem(doc,"body")

if it works I'll post the full code here and award points
Simon-sezAuthor Commented:
Here is the complete code that works for me in case it's helpful to anyone else.  90% of the code is from Bill Hanson so the majority of the credit goes to him.


Sub Initialize
      Const path = "C:\Local\Shared\Detach\"
      Dim s As New notesSession
      Dim db As notesDatabase
      Set db = s.currentDatabase
      Dim docs As notesDocumentCollection
      Set docs = db.unprocessedDocuments
      Dim doc As notesDocument
      Set doc = docs.getFirstDocument
      Dim fileNames, fileObj As notesEmbeddedObject, dotPos As Integer, lastDotPos As Integer
      Dim fullPath As String
      Dim rtitem As notesrichtextitem
      Do Until doc Is Nothing
            If Not doc.hasItem("$File") Then Goto skip
            fileNames = Evaluate("@AttachmentNames",doc)
            Forall filename In fileNames
                  Set fileObj = doc.getAttachment(filename)
                  lastDotPos = Len(filename)+1
                  dotPos = Instr(filename,".")
                  Do Until dotPos = 0
                        lastDotPos = dotPos
                        dotPos = Instr(dotPos+1,filename,".")
                  filename = Left(filename,lastDotPos-1) & " (" & doc.noteID & ")" & Mid(filename,lastDotPos)
                  fullPath = path & doc.GetItemValue("contact")(0)
                  Call DirCreate(fullPath)
                  fileObj.extractFile fullPath & "\" & filename                  
                  Set rtitem = doc.GetFirstItem("body")
                  If rtitem Is Nothing Then
                        Set rtitem = New NotesRichTextItem(doc,"body")
                  End If
                  Call rtitem.AddNewline(2)
                  Call rtitem.AppendText("<<<  Detached: " & filename & "  >>>")
                  Call doc.Save(True, False)
            End Forall
            Set doc = docs.getNextDocument(doc)
End Sub

Public Sub DirCreate(Byval filePath As String)
      ' * Creates a directory.
      ' * @param filePath A string containing the directory to create.  If filePath contains a path with nested directories that do not exist, this function will create all directories in the path.
      ' */
      Dim pathArray As Variant
      Dim temp As String
      Dim dirSep As String
      dirSep = "\"
      pathArray = Split(filePath, dirSep)
      Forall vElement In pathArray
            temp = temp & Cstr(vElement) & dirSep
            If (Not DirExists(temp)) Then Mkdir temp
      End Forall
End Sub
Public Function DirExists(dirName As String) As Variant
      ' * Determines whether a directory exists.
      ' * @param dirName The path of the directory to check.
      ' * @return True if the directory exists.
      ' */
      Dim temp As String
      On Error Goto DONE
      Const ATTR_DIRECTORY = 16
      DirExists = (Dir$(dirName, ATTR_DIRECTORY) <> "")
      Err = 0
      Exit Function
End Function

Simon-sezAuthor Commented:
Grade B because the posted solutions weren't complete or entirely correct but they were enough for me to figure out how to get to the right answer myself.
Sjef BosmanGroupware ConsultantCommented:
Fair 'nuf ;-)

And now you're no longer a newbie...
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Lotus IBM

From novice to tech pro — start learning today.