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.
(Declarations) 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 Attachments") If x <> 6 Then Exit Sub sDefaultFolder = s.GetEnvironmentString ("LPP_ExportAttachments_DefaultFolder") 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) Then 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 ) Then Call ExportAttachment(Obj) Call Obj.Remove Call doc.Save( False, True ) 'creates conflict doc if conflict exists End If End Forall Next 'Scan all items in document Forall i In doc.Items If i.Type = ATTACHMENT Then DOCNames(lngExportedCount) = i.Values(0) lngExportedCount = lngExportedCount + 1 End If End Forall For j% = 0 To lngExportedCount-1 Set attachmentObject = Nothing Set attachmentObject = doc.GetAttachment(DOCNames(j%)) Call ExportAttachment(attachmentObject) Call attachmentObject.Remove Call doc.Save( False, True ) 'creates conflict doc if conflict exists Next Set doc = dc.GetNextDocument(doc) Wend 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, ".") Else sAttachmentName = Strleftback(sAttachmentName, ".") & _ "01." & Strrightback(sAttachmentName, ".") End If Wend 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.