Step 1: Go to the folder of My Document, create a new folder, and name it as OLAttachments

Step 2: Select multiple email messages whose attachments you will remove later.

Note: You can select inconsecutive email messages with holding the Ctrl key and clicking.

You can select consecutive email messages with holding the Shift key and clicking.

Step 3: Open the VBA Editor with pressing the Alt key and F11 key at the same time.

Step 4: Expand the Project1 > Microsoft Outlook Objects in the left bar, and then double click the ThisOutlookSession to open it in the Editor.

Public Sub DeleteAttachments2()
  Dim coll As VBA.Collection
  Dim obj As Object
  Dim Atts As Outlook.Attachments
  Dim Att As Outlook.Attachment
  Dim Sel As Outlook.Selection
  Dim i&, Msg$

  Set coll = New VBA.Collection

  If TypeOf Application.ActiveWindow Is Outlook.Inspector Then
    coll.Add Application.ActiveInspector.CurrentItem
  Else
    Set Sel = Application.ActiveExplorer.Selection
    For i = 1 To Sel.Count
      coll.Add Sel(i)
    Next
  End If

  For Each obj In coll
    Set Atts = obj.Attachments
      For i = Atts.Count To 1 Step -1
        Atts.Remove i
      Next
      obj.Save

  Next
End Sub

JunHu: JunHu/Memo/RemoveOutlookAttachments (last edited 2018-06-25 08:53:22 by JunHu)