Move email items based on a list of email addresses

Status
Not open for further replies.

anil kumar

New Member
Outlook version
Outlook 2010 64 bit
Email Account
POP3
Thank you Diane for quickly responding to my query.

Yes, i have two more email accounts configured in outlook. should i replace this line

Set objDestFolder = objNamespace.GetDefaultFolder(olFolderSentMail).Folders("Unwanted")
with
Set Items = GetFolderPath("anil@xxxx.com\SentMail\Unwanted").Items

and add the snippet in ThisOutlookSession with "After adding the function to ThisOutlookSession" from Working with VBA and non-default Outlook Folders
 

Diane Poremsky

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
Not exactly... replace
Set objDestFolder = objNamespace.GetDefaultFolder(olFolderSentMail).Folders("Unwanted")
with
Set objDestFolder = GetFolderPath("anil@xxxx.com\SentMail\Unwanted")

(and dont forget the getfolderpath function)
 

anil kumar

New Member
Outlook version
Outlook 2010 64 bit
Email Account
POP3
Thank you Diane.

I am not getting error but all the emails from sent folder are moved to unwanted not just the ones i wanted to move listed in addresses-to-move.txt

any thoughts on it?
 

Diane Poremsky

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
I had that problem the first time I used it - that's why I added this line
strAddress = ""
' Use semicolon separator if there is more than 1 address

is your address on your list of names?
 

anil kumar

New Member
Outlook version
Outlook 2010 64 bit
Email Account
POP3
i checked for my address thinking this could be triggering but i didn't find my address at all.

and then i added

strAddress = ";" (tried few times)
strAddress = "" (tried few times)

and ; at the end of all the email addresses in the text file

but still all the email items from sent folder(5666) are moved to unwanted folder(5666).



also just so you know i have added GetRecipientAddress into new module

Public Sub GetRecipientAddress()
'http://slipstick.me/9vjgj
Dim currentExplorer As Explorer
Dim Selection As Selection
Dim obj, objMail As Object
Dim objProp As Outlook.UserProperty
Dim strDomain
Dim Recipients As Outlook.Recipients
Dim recip As String
Dim i
Dim prompt As String
Set currentExplorer = Application.ActiveExplorer
Set Selection = currentExplorer.Selection
On Error Resume Next
For Each obj In Selection
Set objMail = obj
strDomain = ""
Set Recipients = objMail.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)
' Use semicolon separator if there is more than 1 address
If i = 1 Then
strDomain = strDomain & recip
Else
strDomain = strDomain & recip & "; "
End If
Next i
Debug.Print strDomain
' Msgbox strDomain
Set objProp = objMail.UserProperties.Add("Recipient Email", olText, True)
objProp.Value = strDomain
objMail.Save
Err.Clear
Next
Set currentExplorer = Nothing
Set obj = Nothing
Set Selection = Nothing
End Sub



and


added this in thisoutlooksession


Dim WithEvents olSent As Items

Private Sub Application_Startup()
Dim NS As Outlook.NameSpace
Set NS = Application.GetNamespace("MAPI")
Set olSent = NS.GetDefaultFolder(olFolderSentMail).Items
Set NS = Nothing
End Sub
Private Sub olSent_ItemAdd(ByVal Item As Object)
' Fromhttp://slipstick.me/1
Dim objProp As Outlook.UserProperty
Dim strDomain As String
Dim Recipients As Outlook.Recipients
Dim recip As String 'Outlook.Recipient
Dim i
strDomain = ""
Set Recipients = Item.Recipients
For i = Recipients.count To 1 Step -1
recip$ = Recipients.Item(i).Address
'If InStr(1, LCase(recip), "/ou=") Then recip = Right(recip, Len(recip) - InStr(1, LCase(recip), "recipients") - 13)
If i = 1 Then
strDomain = strDomain & recip
Else
strDomain = strDomain & recip & "; "
End If
Next i
Set objProp = Item.UserProperties.Add("Recipient Email", olText, True)
objProp.Value = strDomain
Item.Save
Err.Clear
Set objProp = Nothing
Set Recipients = Nothing
End Sub
 

Diane Poremsky

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
Getrecipients and the thisoutlooksession macros wont have an effect on the one i posted - you'd need to change it to call getrecipients and the itemadd macro just watches for new items. (It's also watching the default account's sent folder, not the one we're working in.
 

anil kumar

New Member
Outlook version
Outlook 2010 64 bit
Email Account
POP3

Diane Poremsky

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
The one I used is attached - it moved 375 messages (of 3700) for these addresses. Before i added the line to clear the recipients string, it moved all, because the string kept growing with each message it processed - eventually, all of the banned named would be found in every message.

The attached macro has a couple of debug.print lines - one with the current item # and the total count, and also for the strAddress value. Ctrl+G will show the immediate window so you can see the values.
alias@gmail.com
alias2@gmail.com
alias@mobilegranny.com
outlook-users@yahoogroups.com
alias@domain.com
alias@outlook.com
 

Attachments

  • MoveMessagesSenderFile-outlookforums.txt
    2.3 KB · Views: 196

Diane Poremsky

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
...and the last test, with 1 entry on the list... it moved all. Sigh.
 

Diane Poremsky

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
Sh**.. figured it out. If you add a line break at the end of last entry, it moves all.

This is the problem -

2018-10-16_9-09-49.png
 

Diane Poremsky

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
ok... this cleans any returns in the string - and you can verify its clean in the immediate window (add a break point after end array so you can see it in the immediate window. The screenshot shows what it looked like with and without the replace line.

Code:
' 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
    
    txt = Replace(txt, vbCrLf, "")

Dim arrAddress() As String
  'Use Split function to return a zero based one dimensional array.
  arrAddress = Split(txt, vbCrLf)
  Debug.Print txt
  Debug.Print "<end>"
' end arrray

2018-10-16_10-20-25.png
 

Diane Poremsky

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
Actually... that might not work with more than one name in the list unless you have commas at the end of each name as its not split yet.... back to the drawing board. :(:(
 
Last edited:

Diane Poremsky

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
As long as the address doesn't have a space, this will work...

Code:
' 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

 
 txt = Replace(txt, vbCrLf, " ")
 txt = Trim(txt)

Dim arrAddress() As String
  'Use Split function to return a zero based one dimensional array.
  arrAddress = Split(txt, " ")
' end arrray


The other option is to clean it like this:

Code:
' 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

If Len(txt) <> 0 Then
 If Right$(txt, 2) = vbCrLf Or Right$(txt, 2) = vbNewLine Then
             txt = Left$(txt, Len(txt) - 2)
End If
End If

Dim arrAddress() As String
  'Use Split function to return a zero based one dimensional array.
  arrAddress = Split(txt, vbCrLf)
' end arrray
 

anil kumar

New Member
Outlook version
Outlook 2010 64 bit
Email Account
POP3
thank you Diane,

i found out that if the caret cursor is at the new line in addresses-to-move.txt text file then all the emails from sent folder will be moved to unwanted.

but if the cursor is at the end of the last email then the whole thing works.

excellent work and thank you very much Diane.
You just made my day.
Thank you again.
 

Diane Poremsky

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
i just realized, this is in the place - not a problem if there is only one recipient.
' clear the string for the next message
strAddress = ""

it should be after
If obj.Class = olMail Then
 

anil kumar

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

just posting the part of edited code. Please let me know if this is good to go or need changes.

' array from list
Dim fn As String, ff As Integer, txt As String
fn = "C:\Users\Daniel\Desktop\addresses-to-move.txt" '< --- .txt file path
txt = Space(FileLen(fn))
ff = FreeFile
Open fn For Binary As #ff
Get #ff, , txt
Close #ff

If Len(txt) <> 0 Then
If Right$(txt, 2) = vbCrLf Or Right$(txt, 2) = vbNewLine Then
txt = Left$(txt, Len(txt) - 2)
End If
End If


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)

Debug.Print objSourceFolder.Items.count
If obj.Class = olMail Then
' clear the string for the next message
strAddress = ""

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)


' Use semicolon separator if there is more than 1 address
If i = 1 Then
strAddress = recip
Else
strAddress = strAddress & recip & "; "
End If

Next i
Debug.Print strAddress
 

mndphaser

New Member
Outlook version
Outlook 2016 64 bit
Email Account
Exchange Server
Hi!

Can you sort several users with in the same domain?

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
bbb@meosxxxxxxxop.fr
bbb@tri-axxx.com
bbb@neuxxxxort.com
bbb@axxxxk.com
ccc@aaxxxx.org
ccc@mckexxxckson.net
ddd@abaraxxxco.com
eee@roxxxxen.com
fff@wbmxxxxn.com
fff@traxxxxinc.com
gg@apxxxxd.com

instead of listing every email address under the same company?

I have tired to use

*@meosxxxxxxxop.fr
**@tri-axxx.com
***@neuxxxxort.com

It works in gmail and G Suite by Google, and Mozilla Thunderbird. What do is the same rules in Microsoft systems?
 

Diane Poremsky

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
Sort into different folders by sender domain using Rules? Yes - use either words in email address or words in header, where the words are the domain.

If you want to sort within the inbox or another folder, you need to use vba to get the domains and add to the view.
 

misha

Member
Outlook version
Outlook 2016 32 bit
Email Account
Exchange Server 2013
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.

yes it can b e done
 
Status
Not open for further replies.
Similar threads
Thread starter Title Forum Replies Date
S Send email via SMTP - use transport rules to add to senders inbox (then rule to move to sent items Exchange Server Administration 1
P move a specified email "From" tag items to a certain folder whenever there is "New Mail" in the inbo Outlook VBA and Custom Forms 5
S Macro to move “Re:” & “FWD:” email recieved the shared inbox to a subfolder in outlook Outlook VBA and Custom Forms 0
D Move Email with Attachment to Folder Outlook VBA and Custom Forms 3
R List folders in a combo box + select folder + move emails from inbox to that folder + reply to that email Outlook VBA and Custom Forms 1
O On click,I want to change subject line of selected mail and then reply to particular email and move Using Outlook 3
L Making rule to move email to folder from one O365 domain Using Outlook 1
acpete48317 Categorize and move Outlook Email Outlook VBA and Custom Forms 2
S Move email accounts to new laptop Using Outlook 1
Diane Poremsky Create Tasks from Email and move to different Task folders New Slipstick.com Articles 0
O VBA Move EMail Outlook VBA and Custom Forms 3
P Move email to folder Using Outlook 1
G email returns after running macro to move emails Outlook VBA and Custom Forms 1
C Outlook 2013 - Email Gets Sent - But Does Not Move From Outbox to Sent Box Using Outlook 4
D Move email to same folder as the rest of the conversation Using Outlook 1
G Outlook 2003 I need to move email to folder based on subject, using wild card Using Outlook 0
K Outlook Cached Mode - can't create rules to move email to another mailbox Using Outlook 2
D User cannot move email messages within Outlook Inbox folder and sub-folders. Using Outlook 0
S Rule to move BCC email to a folder Using Outlook 6
D Delete an email with a video attachment. I can't delete or move it. System shows "not responding" wi Using Outlook 2
E error code MAPI error 0x80040107. I'm trying to move email messages and email lists from my old MS Using Outlook 2
B Move Sent Email to archival pst folder and mark as read - HOW TO Outlook VBA and Custom Forms 2
V move read email based on date and sender Outlook VBA and Custom Forms 6
V Move email using the Close event Outlook VBA and Custom Forms 11
GregS Outlook 2016 Move Outlook to new computer? Using Outlook 4
witzker Macro to move @domain.xx of a Spammail to Blacklist in Outlook 2019 Outlook VBA and Custom Forms 6
G Move tasks up/down todo list by VBA Outlook VBA and Custom Forms 1
S Outlook Macro to move reply mail based on the key word in the subjectline Outlook VBA and Custom Forms 0
Eike Move mails via macro triggered by the click of a button? Outlook VBA and Custom Forms 0
G Cannot Move Autocomplete File to New Computer Using Outlook 15
M Move to Folder Using Outlook 1
P Move emails between 2 mailboxes. Using Outlook 0
C Copy Move item won't work Outlook VBA and Custom Forms 2
N Macro to move all recipients to CC while replying Outlook VBA and Custom Forms 0
Commodore Move turns into "copy" Using Outlook 3
Jennifer Murphy Ctrl+Tab sometimes will not move through text a word at a time Using Outlook 1
V Outlook 2016 will not move emails in search results Using Outlook 4
M move to iCloud not working in outlook calendar Using Outlook 12
A Create date folder and move messages daily Outlook VBA and Custom Forms 1
Commodore Folders always closed in move/copy items dialog box Using Outlook 3
C Move Outlook 2007 to new PC with Outlook 365 Using Outlook 3
C Can't move folder, the folder is full Using Outlook 0
Nadine Rule to move attachments with specific name Outlook VBA and Custom Forms 1
T Move calendar invites to new calendar Using Outlook 5
O Rule to move (specific) messages from Sent folder to Specific folder Using Outlook 1
I Automating message move between folders Outlook VBA and Custom Forms 0
K Outlook Rules: Move a Copy Using Outlook 4
K VBA BeforeItemMove event create rule to always move to its folder. Outlook VBA and Custom Forms 4
N Move emails of same conversation to same subfolder Using Outlook 6
P when i move inbox mails to another folder in outlook the mail disappears Using Outlook 1

Similar threads

Top