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.
