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.