【OutlookVBA】選択したメールの添付ファイルを全て削除する

Outlook上で選択したメールの添付ファイルを全て削除するプログラムです。

Sub SelecetdAttachDelete()

If MsgBox("選択したメールの添付ファイルを削除します。よろしいですか？",  _
vbYesNo) = vbNo Then
   End
End If

Dim objMail As Object
Dim SelectionCount As Long
SelectionCount = ActiveExplorer.Selection.Count  
'何通のメールが選択されているか取得。
'選択されているメールの数だけ添付ファイル削除処理をループする。

Dim i As Long
    i = 1
For i = 1 To SelectionCount
Set objMail = ActiveExplorer.Selection.Item(i)
While objMail.Attachments.Count > 0
      objMail.Attachments.Remove 1
  Wend
      objMail.Save
  Next i

MsgBox "削除しました"

End Sub

プログラムを実行すると、削除プログラムを実行するかどうかのダイアログが出ます。
「はい」を押すとプログラムが実行されて、添付ファイルが削除されます。
削除が終了すると「削除しました」のダイアログが出ます。