Sub RemoveAttachments()
    Dim objSelection As Outlook.Selection
    Dim i, n As Long
    Dim objMail As Outlook.MailItem
    Dim objAttachment As Outlook.Attachment

    'Get the selected emails
    Set objSelection = Outlook.Application.ActiveExplorer.Selection

    'Process each email one by one
    For i = objSelection.Count To 1 Step -1
        If TypeOf objSelection(i) Is MailItem Then
            Set objMail = objSelection(i)
            If objMail.Attachments.Count > 0 Then
                For n = objMail.Attachments.Count To 1 Step -1
                    Set objAttachment = objMail.Attachments.Item(n)
                    objAttachment.Delete
                Next
                objMail.Save
            End If
        End If
    Next i
End Sub