Microsoft Office Forums - View Single Post - OL 2016. "Running rule now" stops too soon.

gmayor · 05-05-2017, 06:36 AM

Use the following macro instead. I have provided alternative lines for messages to someone and from someone. In the case of To, it does not include messages with multiple addresses in 'To ' nor messages where the address is in CC or BCC. For those you would have to loop though the recpients.

Code:

Sub MoveMessages()
Dim olFolder As Outlook.Folder
Dim olItems As Outlook.Items
Dim olItem As Outlook.MailItem
Dim i As Long
Dim strAddress As String
Dim strFolder As String

    strAddress = "someone@somewhere.com"
    strFolder = "Temp" 'subfolder of the default Inbox - must exist
    Set olItems = Session.PickFolder.Items 'Pick the folder containing the messages
    olItems.Sort "[Received]", True
    For i = olItems.Count To 1 Step -1
        Set olItem = olItems(i)
        'If olItem.SenderEmailAddress = strAddress Then 'Messages from someone
        If olItem.To = strAddress Then    'messages to someone
            olItem.Move Session.GetDefaultFolder(olFolderInbox).folders(strFolder)
        End If
        DoEvents
    Next i
    MsgBox "Messages Moved"
lbl_Exit:
    Set olItems = Nothing
    Set olItem = Nothing
    Exit Sub
End Sub