Move email items based on a list of email addresses

anil kumar

New Member
Outlook version
Outlook 2010 64 bit
Email Account
POP3
#1
Hi Diane,

I have a huge number of emails in sent items and i am trying to move email items based on email addresses to a new folder.

but i have a huge list of 1400+ email addresses. I am moving manually by search email address and then move the found items in sent folder to a new folder. can this be done through a macro?

Appreciate a reply.
 

Diane Poremsky

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
#2
If the folder is named for the address, yes - either the full address, the domain, or the alias will work. The display name will may work - it depends if it's the same on replies and new messages.

There is a sample macro on this page - it works on sent items.
Sort messages by Sender domain
 

anil kumar

New Member
Outlook version
Outlook 2010 64 bit
Email Account
POP3
#3
Diane, Thank you for replying my post. I do not want to sort mail items by domain or email address.
Below is a list of few addresses for your ref which i have to search one after another in sent items and move to a folder (only one folder, no specifics)

aaa@meosxxxxxxxop.fr
aaa@tri-axxx.com
aaa@neuxxxxort.com
aaa@axxxxk.com
aaa@aaxxxx.org
aaa@mckexxxckson.net
aaa@abaraxxxco.com
aaa@roxxxxen.com
aaa@wbmxxxxn.com
aaa@traxxxxinc.com
aaa@apxxxxd.com

these addresses are in either csv or excel file
 

Diane Poremsky

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
#4
how many addresses and what are the folder names? You could load them in as an array but it may be slow if the list is huge.

Another option is to use a macro to add the To address to a custom field then group by the field - you'll be able to move all mail to the desired folder at once. It speeds up the manual process - and based on how much time it might take to test and tweak a macro, it could be faster.
 

anil kumar

New Member
Outlook version
Outlook 2010 64 bit
Email Account
POP3
#5
Thanks Diane for quickly responding to me.

How many addresses: 1400+ email addresses.
Mail items to be moved from: sent folder
To be moved to folder : unwanted emails folder

either of them will be of a great use to me. I would be happy if you can help me on this.
FYI: i have multiple email accounts on outlook and if the code refers to just active account, that would be fantastic.
 
Outlook version
Outlook 2010 64 bit
Email Account
POP3
#8
Hi Diane,

if moving is not possible then deleting to trash folder could also do. i can move from trash to whichever folder i want.
please help me with this, thanks
 

Darren

New Member
Outlook version
Outlook 2016 32 bit
Email Account
Exchange Server
#9
they will all be moving to the unwanted folder?
Hi Diane,

Something a bit related slightly off this topic but really needed your assistance related to the following thread: [SOLVED] - Delegate Send, Drafts & Delete Items Functions on Behalf of Client
This was the only way I could try make contact, so please forgive me piggy backing off your thread Alin

I have found information online to get the sent items from the shared mailbox to the shared mailbox sent items through a registry key DelegateSentItemsStyle. So I thought that I could do the same with the Deleted emails from a shared mailbox and add the following key DelegateDeletedItemsStyle, I looked for this possibility and cannot find that it is a valid key. So on investigation found your comment to Britonius where you supplied a link to his delete issue Shared Mailboxes and the Deleted Items Folder
However this is no longer available and was hoping you could share that again please.
Much appreciate your assistance.
Darren NZ
 
Outlook version
Outlook 2010 64 bit
Email Account
POP3
#10
Hi Diane,

Seems you are running on a hectic schedule, could you please let me know if this is possible. Appreciate a reply. Thanks
 
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
#11
I'm always on a hetic schedule. :) And forgot to post my reply - sure glad the site saves drafts. :) Actually, I forgot to post it because I was trying to figure out what I did to save some deleted items in the correct folder. I did it in july or august and it worked until 10/3. Now my mailbox's deleted folder, not the shared mailboxes deleted folder - but they do go into deleted recovery.

Re: the article at Shared Mailboxes and the Deleted Items Folder - The registry key should work with 2016 (I dont have a ready-to-use reg key for it) - but I did something and deleted items are going into the correct deleted folder. But I forget when I did. I dont have the key set.
 
Outlook version
Outlook 2010 64 bit
Email Account
POP3
#12
Diane,

Thanks for replying, but it seems somebody by name darren wanted to get your help and wrote his query in my thread.

Sure Darren would be happy, as he got your help.

it would be great, if you can reply a solution on how to move email items from sent folder by a list of email addresses

[ original post]
How many addresses: 1400+ email addresses.
Mail items to be moved from: sent folder
To be moved to folder : unwanted emails folder

email addresses for your reference:

aaa@meosxxxxxxxop.fr
aaa@tri-axxx.com
aaa@neuxxxxort.com
aaa@axxxxk.com
aaa@aaxxxx.org
aaa@mckexxxckson.net
aaa@abaraxxxco.com
aaa@roxxxxen.com
aaa@wbmxxxxn.com
aaa@traxxxxinc.com
aaa@apxxxxd.com

FYI: i have multiple email accounts on outlook and if the code refers to just active account, that would be fantastic.

Await your reply.
 
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
#13
Oh, sorry about that. The manual method: use this to add the email address field to the view, group by it and delete the groups.
Display the Recipient Email Address in the Sent Items Folder

Not tested (so it might have a typo) and really not practical... but a macro like this should work. (I need to get the code to read the array in from a file.)

If the addresses are 'one-and-done', this is fine, but if you have multiple messages to most of the addresses, using find might be faster (or not.:)).

On, and as written, it is for selected messages - that can be changed too but using the vba editor on my laptop is a pita. When I'm back in my office, I will take a look at it again. (The text in the is a faint gray, hard to read and I can't get changes to stick.)
Code:
Public Sub MoveSelectedMessages()
    Dim objOutlook As Outlook.Application
    Dim objNamespace As Outlook.NameSpace
    Dim objDestFolder As Outlook.MAPIFolder
    Dim objSourceFolder As Outlook.Folder
    Dim currentExplorer As Explorer
    Dim Selection As Selection
    Dim obj As Object
    
    Dim objVariant As Variant
    Dim lngMovedItems As Long
    Dim intCount As Integer
    Dim intDateDiff As Integer
    Dim strDestFolder As String
 
    Set objOutlook = Application
    Set objNamespace = objOutlook.GetNamespace("MAPI")
    Set currentExplorer = objOutlook.ActiveExplorer
    Set Selection = currentExplorer.Selection
    Set objSourceFolder = currentExplorer.CurrentFolder
    
Dim arrAddress As Variant

' Set up the array
arrAddress = Array("address1", "address2", "address3", "address4", "address5", "address6", "address7", "address8", "address9")

    For Each obj In Selection
        Set objVariant = obj
If objVariant.Class = olMail Then

' Go through the array and look for a match, then do something
For i = LBound(arrAddress) To UBound(arrAddress)
If ILCase(objVariant.SenderEmailAddress) = arrAddress Then
    
On Error Resume Next
 Set objDestFolder = objNamespace.GetDefaultFolder(olFolderInbox).Parent.Folders("Unwanted")
   objVariant.Move objDestFolder
    'count the # of items moved
    lngMovedItems = lngMovedItems + 1
GoTo NextMsg
    End If
Next i
        Err.Clear
NextMsg:
    Next

' Display the number of items that were moved.
  MsgBox "Moved " & lngMovedItems & " messages(s)."
    
    Set currentExplorer = Nothing
    Set obj = Nothing
    Set Selection = Nothing
    Set objOutlook = Nothing
    Set objNamespace = Nothing
    Set objSourceFolder = Nothing
End Sub
 
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
#14
this version needs cleaned up a bit, but it works. (The first macro looks at the sender address, not the recipient or To)

This macro gets all recipient addresses and if an address on the list is one of the recipients, the message is moved.

Code:
Public Sub MoveSelectedMessages()
    Dim objOutlook As Outlook.Application
    Dim objNamespace As Outlook.NameSpace
    Dim objDestFolder As Outlook.MAPIFolder
    Dim objSourceFolder As Outlook.Folder
    Dim currentExplorer As Explorer
    Dim Selection As Selection
    Dim obj As Object
  
    Dim objVariant As Variant
    Dim lngMovedItems As Long
    Dim intCount As Integer
    Dim intDateDiff As Integer
    Dim strDestFolder As String

    Set objOutlook = Application
    Set objNamespace = objOutlook.GetNamespace("MAPI")
    Set currentExplorer = objOutlook.ActiveExplorer
    Set Selection = currentExplorer.Selection
    Set objSourceFolder = currentExplorer.CurrentFolder
  
'Dim arrAddress As Variant

' Set up the array
'' arrAddress = Array("address1", "address2", "address3", "address4", "address5", "address6", "address7", "address8", "address9")

' array from list
  Dim fn As String, ff As Integer, txt As String
    fn = "C:\Users\diane\Documents\addresses-to-move.txt" '< --- .txt file path
    txt = Space(FileLen(fn))
    ff = FreeFile
    Open fn For Binary As #ff
    Get #ff, , txt
    Close #ff
Debug.Print txt
Dim arrAddress() As String
  'Use Split function to return a zero based one dimensional array.
  arrAddress = Split(txt, vbCrLf)

''' end arrray

    For Each obj In Selection
        Set objVariant = obj
If objVariant.Class = olMail Then

Dim Recipients As Recipients
Set Recipients = objVariant.Recipients
  For i = Recipients.Count To 1 Step -1
     recip$ = Recipients.Item(i).Address
  
   ' To use only the alias from the x.500 address
   ' If InStr(1, LCase(recip), "/ou=") Then recip = Right(recip, Len(recip) - InStr(1, LCase(recip), "recipients") - 13)
strDomain = ""
' Use semicolon separator if there is more than 1 address
     If i = 1 Then
         strDomain = recip
     Else
         strDomain = strDomain & recip & "; "
     End If

  Next i
     Debug.Print strDomain


' Go through the array and look for a match, then do something
For i = LBound(arrAddress) To UBound(arrAddress)

If InStr(LCase(strDomain), arrAddress(i)) > 0 Then
  
On Error Resume Next
Set objDestFolder = objNamespace.GetDefaultFolder(olFolderInbox).Parent.Folders("Unwanted")
   objVariant.Move objDestFolder
    'count the # of items moved
    lngMovedItems = lngMovedItems + 1
GoTo NextMsg
End If
Next i

NextMsg:
End If
    Next

' Display the number of items that were moved.
  MsgBox "Moved " & lngMovedItems & " messages(s)."
  
    Set currentExplorer = Nothing
    Set obj = Nothing
    Set Selection = Nothing
    Set objOutlook = Nothing
    Set objNamespace = Nothing
    Set objSourceFolder = Nothing
End Sub
 
Last edited:
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
#15
Oh, and because we're moving mail, it's going to skip every other one using this:
For Each obj In Selection

You need to count down. Or instead of moving, assign a category then group by category and move the group yourself.
Replace
objVariant.Move objDestFolder
with
objVariant.categories = "Unwanted"
objVariant.save


ETA: The last macro was missing a line to clear the strDomain - I added it to the macro above.
 
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
#16
This is my final version - the macro counts backwards, so it wont skip any. It works on all messages in the folder, so no need to select all.

Code:
Public Sub MoveSelectedMessages()
  Dim objOutlook As Outlook.Application
  Dim objNamespace As Outlook.NameSpace
  Dim objDestFolder As Outlook.MAPIFolder
  Dim objSourceFolder As Outlook.Folder

  Dim obj As Object
  Dim lngMovedItems As Long
  Dim intCount As Integer
  Dim strAddress As String

  Set objOutlook = Application
  Set objNamespace = objOutlook.GetNamespace("MAPI")
  Set objSourceFolder = objOutlook.ActiveExplorer.CurrentFolder
  Set objDestFolder = objNamespace.GetDefaultFolder(olFolderInbox).Parent.Folders("Unwanted")

' array from list
  Dim fn As String, ff As Integer, txt As String
    fn = "D:\Documents\addresses-to-move.txt" '< --- .txt file path
    txt = Space(FileLen(fn))
    ff = FreeFile
    Open fn For Binary As #ff
    Get #ff, , txt
    Close #ff
Dim arrAddress() As String
  'Use Split function to return a zero based one dimensional array.
  arrAddress = Split(txt, vbCrLf)
' end arrray
For intCount = objSourceFolder.Items.count To 1 Step -1
Set obj = objSourceFolder.Items.Item(intCount)
  
If obj.Class = olMail Then
Dim Recipients As Recipients
Set Recipients = obj.Recipients
  For i = Recipients.count To 1 Step -1
     recip$ = Recipients.Item(i).Address
   ' To use only the alias from the x.500 address
   ' If InStr(1, LCase(recip), "/ou=") Then recip = Right(recip, Len(recip) - InStr(1, LCase(recip), "recipients") - 13)
strAddress = ""
' Use semicolon separator if there is more than 1 address
     If i = 1 Then
         strAddress = recip
     Else
         strAddress = strAddress & recip & "; "
     End If
  Next i
' Go through the array and look for a match, then do something
For i = LBound(arrAddress) To UBound(arrAddress)
If InStr(LCase(strAddress), arrAddress(i)) > 0 Then
On Error Resume Next
   obj.Move objDestFolder
    'count the # of items moved
    lngMovedItems = lngMovedItems + 1
GoTo NextMsg
End If
Next i
NextMsg:
End If
End If
    Next
' Display the number of items that were moved.
  MsgBox "Moved " & lngMovedItems & " messages(s)."

    Set obj = Nothing
  
    Set objOutlook = Nothing
    Set objNamespace = Nothing
    Set objSourceFolder = Nothing
End Sub
 
Outlook version
Outlook 2010 64 bit
Email Account
POP3
#17
Awesome Diane, You are a wonderful and very generous person. i really thank you from the deepest of my heart for your responses.

I have a last query.
should i be adding all three snippets into new module given in https://www.slipstick.com/developer/recipient-email-address-sent-items/?

also i am getting Run time error on the last snippet to move emails

This is my final version - the macro counts backwards, so it wont skip any. It works on all messages in the folder, so no need to select all.

Run time error -2147221233 (8004010f).
The attempted operation failed. An object could not be found.

Set objDestFolder = objNamespace.GetDefaultFolder(olFolderInbox).Parent.Folders("Unwanted")

i have created two folders as "Unwanted" under Inbox and one as sub folder under sent, not sure where its going wrong.

Appreciate if you could help me with this.
 
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
#18
This:
Set objDestFolder = objNamespace.GetDefaultFolder(olFolderInbox).Parent.Folders("Unwanted")

Is pointing to a folder named Unwanted at the same level as the Inbox. If its a subfolder, you need to change the code.
This is subfolder of sent folder:
Set objDestFolder = objNamespace.GetDefaultFolder(olFolderSentMail).Folders("Unwanted")

See Working with VBA and non-default Outlook Folders for more information.
 
Outlook version
Outlook 2010 64 bit
Email Account
POP3
#19
Diane, i have changed the line. Not sure i am still getting the same error for

Set objDestFolder = objNamespace.GetDefaultFolder(olFolderSentMail).Folders("Unwanted")

can you please let me know if anything else has to be changed.
 
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
#20
the only other thing would be the txt file path - but it would stop on this line, not the folder path.
fn = "D:\Documents\addresses-to-move.txt" '< --- .txt file path

Do you have more than one data file in your profile? If so and if the data file is not the default, you need to use the getfolderpath function from Working with VBA and non-default Outlook Folders
 

Similar threads

Top