Move all highlighted emails, not just active one

Hi all - Many thanks to GMAYOR for helping me with a macro that reads the subject line an email and then finds the UID and copies it to the clipboard.

I use this macro to then search my Outlook for the UID. I highlight certain emails and want to send them all to a folder. I have the loop and move part worked out, but it only moves the active/selected email. How do I have VBA move all of the HIGHLIGHTED emails and not just the selected email?

Select Case Outlook.Application.ActiveWindow.Class

Case olInspector

Set myItem = ActiveInspector.CurrentItem

Case olExplorer

Set myItem = Application.ActiveExplorer.Selection.Item(1)

End Select

myItem.Move objNS.GetDefaultFolder(olFolderInbox).Folders(strSubFolder1)

I'm using the terms "active" and "selected" interchangeably which may be inaccurate. By active or selected I mean the email that is being displayed in

In the example attached I left-clicked on Mart's email, I pressed shift and the down arrow twice. Mart's email is displayed in the Reading Pane. Card's email is surrounded by a dotted line. I would say all three are highlighted - but which one is active, which one is selected?; what's the difference/significance between Mart's email being displayed in the reading pane but Card's email being surrounded by the dotted line?

You need to loop through the selection items e.g.

Code:

---

For Each myItem In Application.ActiveExplorer.Selection       
    myItem.Move objNS.GetDefaultFolder(olFolderInbox).folders(strSubFolder1)
Next myItem

---

Quote:

---

Originally Posted by gmayor

You need to loop through the selection items e.g.

Code:

---

For Each myItem In Application.ActiveExplorer.Selection       
    myItem.Move objNS.GetDefaultFolder(olFolderInbox).folders(strSubFolder1)
Next myItem

---

---

That worked like a charm, thank you so much ... again!!

I have one last question about looping.

The macro you helped me create ultimately moves the email with a UID in the subject line to a subfolder with the matching UID. There are a lot of subfolders to loop through, so the loop takes a long time. I suspect my loop is rather primitive. Do you have any suggestions?

Code:

---


Set objSubFolderToLoop = objNS.GetDefaultFolder(olFolderInbox).Folders(strSubFolder1)
Set objSubFolderCount = objSubFolderToLoop.Folders
intSubFolderCount = objSubFolderCount.Count
intLoopSubFolderCounter = 1

       
While intLoopSubFolderCounter <= intSubFolderCount
           
    'HAVING FOUND THE RIGHT FOLDER, MOVE THE EMAIL TO THE FOLDER
    If InStr(strUIDFolderNameCheck, strUID) > 0 Then
               
        For Each myItem In Application.ActiveExplorer.Selection
            myItem.Move objNS.GetDefaultFolder(olFolderInbox).Folders(strSubFolder1)
        Next myItem
        Exit Sub
    Else
        'HAVING NOT FOUND THE RIGHT SUBFOLDER MOVE ON TO THE NEXT ONE
        intLoopSubFolderCounter = intLoopSubFolderCounter + 1
    End If


Wend

---

I got it!! I used the For Each loop ... just had to figure it all out.

Using the While/Wend loop for the 280 some folders it took 9-10 seconds to loop to the end.

Using the For Each loop it takes about 1-2 seconds.