Public Sub StripMailsInCurrentFolder()
    Dim objMsg As Object
    Dim objAttachments As Outlook.Attachments
    Dim i As Long
    Dim lngCount As Long
    Dim strFile As String
    Dim strFolder As String
    Dim strMsg As String
    Dim lngProgress As Long
    
    Dim result
    
    On Error Resume Next
    
    ' Get the collection of selected objects.
    Set objSelection = Application.ActiveExplorer.CurrentFolder.Items
    result = MsgBox("Do you want to strip " & objSelection.Count & " messages in folder " & Application.ActiveExplorer.CurrentFolder, vbYesNo + vbQuestion)
    If result = vbNo Then
        Exit Sub
    End If
    
    ' Check each selected item for attachments.
    ' If attachments exist, save them to the Temp
    ' folder and strip them from the item.
    For Each objMsg In objSelection
    ' This code only strips attachments from mail items.
        If objMsg.Class = olMail Then
            ' Get the Attachments collection of the item.
            Set objAttachments = objMsg.Attachments
            lngCount = objAttachments.Count
            If lngCount > 0 Then
                ' We need to use a count down loop for
                ' removing items from a collection. Otherwise,
                ' the loop counter gets confused and only every
                ' other item is removed.
                For i = lngCount To 1 Step -1
                    objAttachments.Item(i).Delete
                Next i
            End If
            objMsg.HTMLBody = Left(objMsg.HTMLBody, 16384)
            objMsg.Save
        End If
    Next
    
    Set objAttachments = Nothing
    Set objMsg = Nothing
    Set objSelection = Nothing
    Set objOL = Nothing
End Sub