Extract attachments and indicate a new location

This tip shows you how to 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.

Dig Deeper on Lotus Notes Domino Coding and Development

Start the conversation

Send me notifications when other members comment.

Please create a username to comment.

-ADS BY GOOGLE

SearchWindowsServer

Search400

  • iSeries tutorials

    Search400.com's tutorials provide in-depth information on the iSeries. Our iSeries tutorials address areas you need to know about...

  • V6R1 upgrade planning checklist

    When upgrading to V6R1, make sure your software will be supported, your programs will function and the correct PTFs have been ...

  • Connecting multiple iSeries systems through DDM

    Working with databases over multiple iSeries systems can be simple when remotely connecting logical partitions with distributed ...

SearchDataCenter

SearchContentManagement

Close