Extract attachments and indicate a new location

This tip is a modification of the Ken Pespisa's tip Extract attachments from e-mail. After saving the attachment in another directory, the new location is appended to the body of the e-mail so that it's easy to find the next time it's needed.

  Code: Sub Initialize
 Dim sDir As String
 Dim s As NotesSession
 Dim w As NotesUIWorkspace
 Dim db As NotesDatabase
 Dim doc As NotesDocument
 Dim uidoc As NotesUIDocument
 
 Set s = New NotesSession
 Set w = New NotesUIWorkspace 
 Set db = s.CurrentDatabase
 Set uidoc = w.CurrentDocument
 Set doc = uidoc.Document
 Dim rtItem As NotesRichTextItem
 Dim sDefaultFolder As String
 Dim x As Integer
 Dim vtDir As Variant
 Dim j As Integer
 Dim text As String
 Dim text2 As String
 text = ""
 text2 = ""
 
 x = Msgbox("This action will extract all
 attachments from the  document and 
place them into the folder of your choice." & _
 Chr(10) & Chr(10) & "Would you like to continue?", 
32 + 4, "Export 
Attachments")
 If x <> 6 Then Exit Sub 
 
 sDefaultFolder = s.GetEnvironmentString("ExtractAgent")
 vtDir = w.SaveFileDialog( False, 
"Export attachments to which folder?", "All 
files|*.*", sDefaultFolder, "Choose Folder and Click Save")
 If Isempty(vtDir) Then Exit Sub
 sDir = Strleftback(vtDir(0), "Choose Folder and Click Save")
 Call s.SetEnvironmentVar("ExtractAgent",vtDir(0))
 
 Set rtitem = doc.GetFirstItem( "Body" )
 If ( rtitem.Type = RICHTEXT ) Then
  Forall o In rtitem.EmbeddedObjects
   If ( o.Type = EMBED_ATTACHMENT )  
And ( o.FileSize > MAX ) Then
    fileCount = fileCount + 1
    Call o.ExtractFile ( sDir + o.Name )
    Call rtItem.AddNewline(1)
    text = o.Name + " has been moved to " +
 sDir + " by " + s.UserName + " 
on " + Str$(Today()) +  ".  "
    Call rtitem.AppendText("<< " + text + " >>") 
    text2 = text2 + text
    Call rtItem.AddNewline(1)
    Call o.Remove
    Call doc.Save( True, True )
   End If
  End Forall
 End If 
 
 Msgbox text2, 16, "Document(s) Detached"
 Call uidoc.Close
 
End Sub

Do you have comments on this tip? Let us know.

This tip was submitted to the SearchDomino.com tip exchange by member Bil McConoughey. Please let others know how useful it is via the rating scale at the end of the tip. Do you have a useful Notes/Domino tip or code to share? Submit it to our monthly tip contest and you could win a prize and a spot in our Hall of Fame.