Move all highlighted emails, not just active one

[pebcak]

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?

[gmayor]

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


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

[pebcak]

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


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?





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

[pebcak]

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.