Extract attachments from e-mail

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 SearchDomino.com 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.

This was first published in December 2004

There are Comments. Add yours.

TIP: Want to include a code block in your comment? Use <pre> or <code> tags around the desired text. Ex: <code>insert code</code>

REGISTER or login:

Forgot Password?
By submitting you agree to receive email from TechTarget and its partners. If you reside outside of the United States, you consent to having your personal data transferred to and processed in the United States. Privacy
Sort by: OldestNewest

Forgot Password?

No problem! Submit your e-mail address below. We'll send you an email containing your password.

Your password has been sent to:

Disclaimer: Our Tips Exchange is a forum for you to share technical advice and expertise with your peers and to learn from other enterprise IT professionals. TechTarget provides the infrastructure to facilitate this sharing of information. However, we cannot guarantee the accuracy or validity of the material submitted. You agree that your use of the Ask The Expert services and your reliance on any questions, answers, information or other materials received through this Web site is at your own risk.