Manage Learn to apply best practices and optimize your operations.

Extract attachments from e-mail

This agent will help make extracting attachments easier. The agent removes all attachments from the selected e-mails and places them into a folder chosen by the user.

At my company, we're constantly trying to keep our users' mail file sizes down. One method we suggest is to extract large attachments out of their mail files and save them on their network drives. There, they can more easily spot and remove the duplicates (which often get sent back and forth in e-mail conversations). The files can then be burned to a CD, if necessary, and the CD given to the user so the network drive doesn't get full.

This agent will help make extracting attachments easier. The agent removes all attachments from the selected e-mails and places them into a folder chosen by the user. When the script encounters a filename conflict, it appends an 01, 02, etc., to the end of the filename, so that every attachment is saved and none are overwritten. The agent can be placed into the company's custom mail template, or it can be added to any individual mail file design.

To install, just create a new agent called "Mail Tools \\ Extract Attachments From Selected Emails," or something else appropriate. The agent needs to operate on Selected Documents to work. Copy the code below into the appropriate sections of the agent, save it and then run it from the Actions menu with the mail file.

Dim sDir As String
Dim s As NotesSession
Dim w As NotesUIWorkspace
Dim db As NotesDatabase
Dim dc As NotesDocumentCollection
Dim doc As NotesDocument

Sub Initialize
 Set s = New NotesSession
 Set w = New NotesUIWorkspace 
 Set db = s.CurrentDatabase
 Set dc = db.UnprocessedDocuments
 Set doc = dc.GetFirstDocument
 Dim rtItem As NotesRichTextItem
 Dim RTNames List As String
 Dim DOCNames List As String
 Dim itemCount As Integer
 Dim sDefaultFolder As String
 Dim x As Integer
 Dim vtDir As Variant
 Dim iCount As Integer
 Dim j As Integer
 Dim lngExportedCount As Long
 Dim attachmentObject As Variant
 x = Msgbox("This action will extract all
 attachments from the " & Cstr
(dc.Count) & _
 " document(s) you have selected, 
and place them into the folder of your 
choice." & _
 Chr(10) & Chr(10) & "Would you like 
to continue?", 32 + 4, "Export 
 If x <> 6 Then Exit Sub 
 sDefaultFolder = s.GetEnvironmentString
 If sDefaultFolder = "" Then sDefaultFolder = "F:"
 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), "\")
 Call s.SetEnvironmentVar
("LPP_ExportAttachments_DefaultFolder", sDir) 
 While Not (doc Is Nothing)
  iCount = 0
  itemCount = 0
  lngExportedCount = 0
  Erase RTNames
  Erase DocNames
  'Scan all items in document
  Forall i In doc.Items
   If i.Type = RICHTEXT Then
    Set rtItem = doc.GetfirstItem(i.Name)
    If Not Isempty(rtItem.EmbeddedObjects) 
     RTNames(itemCount) = Cstr(i.Name)
     itemCount = itemCount +1
    End If
   End If
  End Forall  
  For j = 0 To itemCount-1 
   Set rtItem = Nothing
   Set rtItem = doc.GetfirstItem(RTNames(j))
   Forall Obj In rtItem.EmbeddedObjects
    If ( Obj.Type = EMBED_ATTACHMENT ) 
     Call ExportAttachment(Obj)
     Call Obj.Remove
     Call doc.Save( False, True ) 
 'creates conflict doc if conflict exists
    End If 
   End Forall 
  'Scan all items in document
  Forall i In doc.Items
   If i.Type = ATTACHMENT Then
    DOCNames(lngExportedCount) = 
    lngExportedCount = lngExportedCount + 1
   End If
  End Forall
  For j% = 0 To lngExportedCount-1 
   Set attachmentObject = Nothing
   Set attachmentObject = 
   Call ExportAttachment(attachmentObject)   
   Call attachmentObject.Remove   
   Call doc.Save( False, True ) 
'creates conflict doc if conflict exists
  Set doc = dc.GetNextDocument(doc)
 Msgbox "Export Complete.", 16, "Finished"
End Sub

Sub ExportAttachment(o As Variant)
 Dim sAttachmentName As String
 Dim sNum As String
 Dim sTemp As String
 sAttachmentName = sDir 
& "\" & o.Source
 While Not (Dir$(sAttachmentName, 0) = "")
  sNum = Right
(Strleftback(sAttachmentName, "."), 2)
  If Isnumeric(sNum) Then
   sTemp = Strleftback(sAttachmentName, ".")
   sTemp = Left(sTemp, Len(sTemp) - 2)
   sAttachmentName = sTemp
 & Format$(Cint(sNum) + 1, "##00") & _
   "." & Strrightback(sAttachmentName, ".")
   sAttachmentName = 
Strleftback(sAttachmentName, ".") & _
   "01." & Strrightback(sAttachmentName, ".")
  End If
 Print "Exporting " & sAttachmentName
 'Save the file
 Call o.ExtractFile( sAttachmentName ) 
End Sub

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

This tip was submitted to the tip exchange by member Ken Pespisa. Please let others know how useful it is via the rating scale below. 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 Agents



  • iSeries tutorials'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 ...