Option Explicit
Sub MoveItems()
Dim Messages As Selection
Dim Msg As MailItem
Dim NamSpace As NameSpace
Dim Proceed As VbMsgBoxResult
Set NamSpace = Application.GetNamespace("MAPI")
Set Messages = ActiveExplorer.Selection
If Messages.Count = 0 Then
Exit Sub
End If
For Each Msg In Messages
If Msg.FlagStatus = 2 Then
Proceed = MsgBox("Are you sure you want to clear the flag and move the message " _
& """" & Msg & """" & " to the folder " & """" & "Idea" & """" & "?", _
vbYesNo + vbQuestion, "Confirm Procedure")
If Proceed = vbYes Then
Msg.FlagStatus = olNoFlag
Msg.Move NamSpace.Folders("Personal Folders").Folders("Idea")
End If
End If
Next
End Sub
|