Move selected email to folder based inputbox value, Outlook

Question

could someone help me to create script for moving emails in the outlooks folders based on value added to inputbox?

Idea is that, I select one or more emails and run script. Input box appeard and I fill in 6 digits. If the filled folder name exist anywhere in Outlook inbox the script move these selected emails to this folder. If the folder name doesnt exist, then MsgBox (No such folder) If the folder name exist more then once, then MsgBox (Multiple records)

This is my first outlook code, please be kind to me, thank you.

Answer 1

Use the Move method of the MailItem (or any Outlook items) for moving selected items to a folder. To find out which items are selected in Outlook you could use the Selection property of the Explorer class which returns a Selection object that contains the item or items that are selected in the explorer window.

Sub GetSelectedItems() 
 Dim myOlExp As Outlook.Explorer
 Dim myOlSel As Outlook.Selection 
 Dim mySender As Outlook.AddressEntry 
 Dim oMail As Outlook.MailItem 
 Dim oAppt As Outlook.AppointmentItem 
 Dim oPA As Outlook.PropertyAccessor 
 Dim MsgTxt As String 
 Dim x As Long 
 
 MsgTxt = "Senders of selected items:" 
 Set myOlExp = Application.ActiveExplorer 
 Set myOlSel = myOlExp.Selection 
 For x = 1 To myOlSel.Count 
   If myOlSel.Item(x).Class = OlObjectClass.olMail Then 
     ' For mail item, use the SenderName property. 
     Set oMail = myOlSel.Item(x) 
     MsgTxt = MsgTxt & oMail.SenderName & ";" 
   ElseIf myOlSel.Item(x).Class = OlObjectClass.olAppointment Then 
     ' For appointment item, use the Organizer property. 
     Set oAppt = myOlSel.Item(x) 
     MsgTxt = MsgTxt & oAppt.Organizer & ";" 
   End If 
 Next x 
 
 Debug.Print MsgTxt 
 
End Sub

For example, the following code locates items from a specific sender and then moves them to a subfolder:

Sub MoveItems() 
 Dim myNameSpace As Outlook.NameSpace 
 Dim myInbox As Outlook.Folder 
 Dim myDestFolder As Outlook.Folder 
 Dim myItems As Outlook.Items 
 Dim myItem As Object 
 
 Set myNameSpace = Application.GetNamespace("MAPI") 
 Set myInbox = myNameSpace.GetDefaultFolder(olFolderInbox) 
 Set myItems = myInbox.Items 
 Set myDestFolder = myInbox.Folders("Personal Mail") 
 Set myItem = myItems.Find("[SenderName] = 'Eugene Astafiev'") 
 While TypeName(myItem) <> "Nothing" 
 myItem.Move myDestFolder 
 Set myItem = myItems.FindNext 
 Wend 
End Sub

To find the folder in Outlook you need to iterate over all folders recursively. The Outlook object model doesn't provide any property or method to find a folder by its name. See Enumerate folders for more information.