To do just what you need to do with your emails.
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
........................................
Happy computing. :)
Please post back if you have any more problems or questions.