title: Lotus Notes Agent - Remove Embedded Images?
body: <p>I have an agent someone shared years ago which takes attached files, saves them to my hard drive, and removes them from the email.  I use it to keep my emails for a while but stay under my corporate mailbox quota.  I get a LOT of attachments.  </p>
  
  <p>I'm now finding that a lot of the remaining large emails have embedded images rather than "attached files".  Can anyone share a script that would actually be able to do the same (save to hard drive, remove from email) with an embedded image?</p>
  
  <p>FWIW, here is the agent I use for detaching attachments.  Props to original author, don't know who that was.</p>
  
  <pre><code>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 vtDir As Variant
      Dim iCount As Integer
      Dim j As Integer
      Dim lngExportedCount As Long
      Dim attachmentObject As Variant
      Dim text As String
  
      Dim subjectLine As String
      Dim attachmentMoved As Boolean
  
      ' Prompt the user to ensure they wish to continue extracting the attachments
      Dim x As Integer
      x = Msgbox("V4 This action will extract all attachments from the " &amp; Cstr (dc.Count) &amp;  " document(s) you have selected, and place them into the folder of your choice." &amp; _
      Chr(10) &amp; Chr(10) &amp; "Would you like to continue?", 32 + 4, "Export Attachments")
      If x &lt;&gt; 6 Then Exit Sub 
  
      ' Set the folder where the attachments will be exported
      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) 
  
      ' Loop through all the selected documents
      While Not (doc Is Nothing)
  
          iCount = 0
          itemCount = 0
          lngExportedCount = 0
          Erase RTNames
          Erase DocNames
  
          ' Find all of the RichText fields in the current document.  If any have an embedded object, add the item to the RTNames array.
          Forall i In doc.Items
              If i.Type = RICHTEXT Then
                  If Not Isempty(i.EmbeddedObjects) Then
                      'Msgbox i.Name,64,"Has embedded objects"                    
                  End If
                  Set rtItem = doc.GetfirstItem(i.Name)
                  'Set rtItem = i
                  If Not Isempty(rtItem.EmbeddedObjects) Then
                      RTNames(itemCount) = Cstr(i.Name)
                      itemCount = itemCount +1
                  End If
              End If
  
          End Forall  
  
          ' Loop through the RTNames array and see if any of the embedded objects are attachments
          attachmentMoved = False
          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
                      ' The embedded object is an attachment.  Export it to the chosen directory
                      Call ExportAttachment(Obj)
  
                      ' Append to the bottom of the file details on the extracted file and its new location. 
                      Call rtItem.AddNewline(1)
                      Call rtitem.AppendText("---------------------------------------" + Chr(13) + Chr(10)) 
  
                      text = """" + sDir + "\"+ Obj.Name + """" + Chr(13) + Chr(10) + Chr(9) + "Extracted by: " + s.UserName + " on " + Str$(Today()) +  ".  "
                      Call rtitem.AppendText(text )               
                      Call rtItem.AddNewline(1)               
  
                      ' Remove the object from the file and save the document.
                      Call Obj.Remove
                      Call doc.Save( False, True )  'creates conflict doc if conflict exists
                      attachmentMoved = True
                  Else
                      Forall verb In Obj.Verbs
                          'Msgbox verb, 64, "VERB"
                      End Forall
                  End If 
              End Forall 
  
              ' If the document had an attachment moved, update the subject line 
              If attachmentMoved = True Then
                  Dim item As Notesitem
                  Set item = doc.GetFirstItem("Subject")
                  subjectLine = item.Text + "- ATTACHMENT MOVED"
                  Set item = doc.ReplaceItemValue("Subject", subjectLine)
                  Call doc.Save( False, True )  'creates conflict doc if conflict exists
              End If
          Next
  
          Set doc = dc.GetNextDocument(doc)
      Wend
  
      Msgbox "Export Complete.", 64, "Finished"
  
  End Sub
  
  Sub ExportAttachment(o As Variant)
  
      Dim sAttachmentName As String
      Dim sNum As String
      Dim sTemp As String
  
      ' Create the destination filename
      sAttachmentName = sDir &amp; "\" &amp; o.Source
  
      ' Loop through until the filename is unique
      While Not (Dir$(sAttachmentName, 0) = "")
  
          ' Get the last three characters of the filename - "_XX"
          sNum = Right(Strleftback(sAttachmentName, "."), 3)
  
          ' Ensure the first of the three characters is an underscore and the next two are numeric.  If they are, add one to the existing number and insert it back in.
          If Left(sNum,1) = "_" And Isnumeric(Right(sNum, 2)) Then
              sTemp = Strleftback(sAttachmentName, ".")
              sTemp = Left(sTemp, Len(sTemp) - 2)
              sAttachmentName = sTemp &amp; Format$(Cint(Right(sNum,2)) + 1, "##00") &amp; "." &amp; Strrightback(sAttachmentName, ".")
          Else
              sAttachmentName = Strleftback(sAttachmentName, ".") &amp; "_01." &amp; Strrightback(sAttachmentName, ".")
          End If
      Wend
  
      ' Save the file
      Call o.ExtractFile( sAttachmentName ) 
  
  End Sub 
  </code></pre>