選択メールのみ添付ファイル削除

Sub 選択メールの添付ファイル削除()
    Set myOlApp = CreateObject("Outlook.Application")

    Set myOlSel = myOlApp.ActiveExplorer.Selection
    
    If myOlSel.Count = 0 Then
        MsgBox "メールが選択されていません"
        Exit Sub
    End If
    
    If vbYes <> MsgBox(myOlSel.Count & "通のメールが選択されています" & vbCrLf & "添付ファイルを削除しますか？", vbYesNo) Then
        Exit Sub
    End If
    
    For x = 1 To myOlSel.Count
        Set myitem = myOlSel.Item(x)
        Set myattachments = myitem.Attachments
        While myattachments.Count > 0
            myattachments.Remove 1
        Wend
        myitem.Save
    Next
    MsgBox "終了しました"
End Su