Sub ReAttach()
Dim olItem As MailItem
Dim olAtt As Attachment
Dim sName As String
Dim sPath As String
Dim cNames As Collection
Dim i As Long

    sPath = Environ("TEMP") & "\"
    On Error Resume Next
    Select Case Outlook.Application.ActiveWindow.Class
        Case olInspector
            Set olItem = ActiveInspector.currentItem
        Case olExplorer
            Set olItem = Application.ActiveExplorer.Selection.Item(1)
    End Select
    olItem.Save
    Set cNames = New Collection
    If olItem.Attachments.Count > 0 Then
        For i = olItem.Attachments.Count To 1 Step -1
            Set olAtt = olItem.Attachments(i)
            sName = olAtt.FileName
            If Not sName Like "image*.jpg" Then
                sName = Replace(olAtt.FileName, "%20", " ")
                olAtt.SaveAsFile sPath & sName
                cNames.Add sPath & sName
                olAtt.Delete
            End If
        Next i
        For i = 0 To cNames.Count
            'Debug.Print cNames(i)
            olItem.Attachments.Add cNames(i)
            Kill cNames(i)
        Next i
    End If
lbl_Exit:
    Set olItem = Nothing
    Set olAtt = Nothing
    Set cNames = Nothing
    Exit Sub
End Sub