Move all Outlook folders that has 1 or more than 1 external email's.

Script code examples to build from here:
http://www.outlookcode.com (download Sues Code examples)
http://www.slovaktech.com/code_samples.htm

peakpeak,
Yes, we know that in your profile that you have put:
"Never reinvent the Wheel. Use Google."
However here you and we are expected to provide specific help which directly assists the questioner. To provide a link to another site is not encouraged in EE as it essentaily says "We have not got people of the right caliblre and ability to provide you with an answer."
 Whilst you may not care about that, the owners of EE, who run this as a commercial venture, rely on people using EE as the site to solve their IT problems. By providing just a link a link to another site completely fails to help either EE as a site and in the instance of this question in all probability completely fails to help bsharath.
bsharath may know some VBA, but he is a busy man and depends upon helpers here to provide specifically tailored solutions to meet his needs. I should know as I provide him with solutions regularly - and they are all very specific.
Let's be blunt, the worst thing about your approach, is that because the question shows up as having received some help it will automatically discourage others from looking in. After all what's the point of even looking at a question if it's already been answered?
So may I strongly encourage you not to give just links to other websites, but in the Excel forum - here in other words - even if nowhere else in Experts Exchange, to give complete answers with code and an attached file when appropriate. I am sure your contributions will be approciated far more if you take the time and trouble to go that extra mile.
Patrick

Hear Hear

And I know from a previous post that Sharath has explicitly asked PeakPeak to desist from this.

SHarath

I know you have provided domain info before, but whilst there is no need to post it here can you identify the domain(s) that relate to internal emails?  i.e. if the answer is yes then how many unique domains ... and I can try and code something that uses constants you can define off-line for example

myconst = "*@fred.com,*@doris.net"

That being so then I think I can put something together.

Chris

Hi Chris...
Sent a mail to you....

Hi Chris...
Sent a mail to you....

For the record, Sharath has identified that there are two domains to be considered, (i.e. "*@fred.com,*@doris.net")

Sharath

Are we talking one specific PST at a time or all of them?

Chris

They are 1 pst at a time.

Please NOTE they are from the Sent mails that i want to move.

So the TO name has to be considered and not the From

They are 1 pst at a time.

Please NOTE they are from the Sent mails that i want to move.

So the TO name has to be considered and not the From

How should sub folders of a folder containing an external email be addressed?

Moved with their complete sub structure?
note anything else could be difficult

Chris

No folder will have sub folder'
I have the structure as this

>Sent (Folder)
>> Folder1
>> Folder2
>> Folder3
And so on

There will be subfolders.

No folder will have sub folder'
I have the structure as this

>Sent (Folder)
>> Folder1
>> Folder2
>> Folder3
And so on

There will be subfolders.

ANd I guess you want to exclude trhe sent folder itself and only work this on teh sub folders 1 .. n?

Chris

I have assumed the folder selected is a parent folder, and do not try to move that folder.

You need to append your two domains as previously identified as
Const excludeDomain1 = "@***.com"
Const excludeDomain2 = "@*****.com"

I also assume all emails are moved to the same new folder

To trigger teh activity call extemailinFolder

Chris

Sub extemailinFolder()
Dim myfolder As MAPIFolder
Dim movetofolder As Outlook.MAPIFolder
        
        For Each myfolder In Application.GetNamespace("mapi").PickFolder.folders
            recur_extemailinFolder myfolder, movetofolder
        Next
 
End Sub
Sub recur_extemailinFolder(startFolder As MAPIFolder, ByRef movetofolder As MAPIFolder)
Dim fldr As Outlook.MAPIFolder
Dim folderItems As Outlook.items
Dim foundOne As Boolean
Dim recip As Outlook.Recipient
Dim objItem As Object
Dim mai As Outlook.mailitem
Const excludeDomain1 = "@***.com"
Const excludeDomain2 = "@*****.com"
 
    foundOne = False
    On Error Resume Next
    
    ' process all the items in this folder
    For Each objItem In startFolder.items
        If TypeName(objItem) = "MailItem" Then
            Set mai = objItem
            For Each recip In mai.Recipients
                If LCase(Right(recip.Address, Len(excludeDomain1))) <> LCase(excludeDomain1) And _
                LCase(Right(recip.Address, Len(excludeDomain2))) <> LCase(excludeDomain2) _
                    Then foundOne = True
            Next
        End If
        If foundOne Then Exit For
    Next
    If foundOne Then
        Debug.Print "Need to move folder " & startFolder.FolderPath
        If movetofolder Is Nothing Then
            MsgBox "Navigate to the folder where those containing external addresses are to be moved", vbOKOnly, "Move folder"
            Set movetofolder = Application.GetNamespace("mapi").PickFolder
        End If
        startFolder.moveto movetofolder
    End If
 
End Sub

Select allOpen in new window

Sharath!

To duplicate the comment in the other thread ...

The script should move any folder where ANY email in teh folder has an address outside the defined domains ... is that not what is required?

Chris

:-(

Sorry the comments has to be here

>>Ok i get this
Need to move folder \\Mailbox - Sharath \Inbox\Anulio
in the immediate window. But its an local user with all mails sent to an local domain user that i have mentions
@abc.com

Yes thats right for a test i have 3 folders with 1 mail in each folder that i have sent to internal employees and another folder with external email but they all get moved to the folder that i selected

:-(

Sorry the comments has to be here

>>Ok i get this
Need to move folder \\Mailbox - Sharath \Inbox\Anulio
in the immediate window. But its an local user with all mails sent to an local domain user that i have mentions
@abc.com

Yes thats right for a test i have 3 folders with 1 mail in each folder that i have sent to internal employees and another folder with external email but they all get moved to the folder that i selected

Same general process but for now I will hold the actual move but keep the displayed comment in teh debug.

It adds in teh debug the email in the folder that has an external addressee i.e. the email that triggered the move requirement

Chris

Sub extemailinFolder()
Dim myfolder As MAPIFolder
Dim movetofolder As Outlook.MAPIFolder
        
        For Each myfolder In Application.GetNamespace("mapi").PickFolder.folders
            recur_extemailinFolder myfolder, movetofolder
        Next
 
End Sub
Sub recur_extemailinFolder(startFolder As MAPIFolder, ByRef movetofolder As MAPIFolder)
Dim fldr As Outlook.MAPIFolder
Dim folderItems As Outlook.items
Dim foundOne As Boolean
Dim recip As Outlook.Recipient
Dim objItem As Object
Dim mai As Outlook.mailitem
Const excludeDomain1 = "@***.com"
Const excludeDomain2 = "@*****.com"
 
    foundOne = False
    On Error Resume Next
    
    ' process all the items in this folder
    For Each objItem In startFolder.items
        If TypeName(objItem) = "MailItem" Then
            Set mai = objItem
            For Each recip In mai.Recipients
                If LCase(Right(recip.Address, Len(excludeDomain1))) <> LCase(excludeDomain1) And _
                    LCase(Right(recip.Address, Len(excludeDomain2))) <> LCase(excludeDomain2) Then
                        foundOne = True
                        Debug.Print mai.subject & vbTab & recip.Address
                End If
            Next
        End If
        If foundOne Then Exit For
    Next
    If foundOne Then
        Debug.Print "Need to move folder " & startFolder.FolderPath
'        If movetofolder Is Nothing Then
'            MsgBox "Navigate to the folder where those containing external addresses are to be moved", vbOKOnly, "Move folder"
'            Set movetofolder = Application.GetNamespace("mapi").PickFolder
'        End If
'        startFolder.moveto movetofolder
        
    End If
 
End Sub

Select allOpen in new window

I get this in the immediate window. The names are slightly altered. Format is same

Please check if these details are correct   /O=GROUP/OU=FIRST ADMINISTRATIVE GROUP/CN=RECIPIENTS/CN=ABDLG
Please check if these details are correct   /O=GROUP/OU=FIRST ADMINISTRATIVE GROUP/CN=RECIPIENTS/CN=SHARATHKI
Need to move folder \\Mailbox - Sharath gty\Inbox\Abdl Gf
Virus Alert (Action Required)   /O=GROUP/OU=FIRST ADMINISTRATIVE GROUP/CN=RECIPIENTS/CN=Abduimmoh
Need to move folder \\Mailbox - Sharath gty\Inbox\Abdlra ty

Select allOpen in new window

I get this in the immediate window. The names are slightly altered. Format is same

Please check if these details are correct   /O=GROUP/OU=FIRST ADMINISTRATIVE GROUP/CN=RECIPIENTS/CN=ABDLG
Please check if these details are correct   /O=GROUP/OU=FIRST ADMINISTRATIVE GROUP/CN=RECIPIENTS/CN=SHARATHKI
Need to move folder \\Mailbox - Sharath gty\Inbox\Abdl Gf
Virus Alert (Action Required)   /O=GROUP/OU=FIRST ADMINISTRATIVE GROUP/CN=RECIPIENTS/CN=Abduimmoh
Need to move folder \\Mailbox - Sharath gty\Inbox\Abdlra ty

Select allOpen in new window

Ah yes my lack of connectivity!

Is it the case then that any recipient that is not in the GPO is treated as an external addressee ... i.e. if the email is presented as above then it is ignored but if it has an email x@y.com for example then these are the only addresses that are considered.

Note it is possible to append a block to bring the domain out ... but it's a level of complexity that is worth excluding since it is all processor power.

i.e. to restate, do I ignore addresses with /GROUP etc in them and only select folders with addresses that do not contain the GPO breakdown?

Chris

Ok can try that...

With group i need to add some other data. Personal. Can you mention where i need to edit

Ok can try that...

With group i need to add some other data. Personal. Can you mention where i need to edit

>>> With group i need to add some other data

Can you give some kind of clue?

Chris

I mean

/O=GROUP/OU=FIRST ADMINISTRATIVE GROUP/CN=RECIPIENTS/CN=ABDLG
Will have as
/O=abc123GROUP/OU=FIRST ADMINISTRATIVE GROUP/CN=RECIPIENTS/CN=ABDLG

No worries ... I think

Be back soon with a change

Chris

This code will still not move the folder but it will still output a comment if the folder 'should' be moved.  Let me know how it looks and if OK i'll re-enable the move action

Chris

Sub recur_extemailinFolder(startFolder As MAPIFolder, ByRef movetofolder As MAPIFolder)
Dim fldr As Outlook.MAPIFolder
Dim folderItems As Outlook.items
Dim foundOne As Boolean
Dim recip As Outlook.Recipient
Dim objItem As Object
Dim mai As Outlook.mailitem
'Const excludeDomain1 = "@***.net"
'Const excludeDomain2 = "@*****.com"
 
    foundOne = False
    On Error Resume Next
    
    ' process all the items in this folder
    For Each objItem In startFolder.items
        If TypeName(objItem) = "MailItem" Then
            Set mai = objItem
            For Each recip In mai.Recipients
'                If LCase(Right(recip.Address, Len(excludeDomain1))) <> LCase(excludeDomain1) And _
                    LCase(Right(recip.Address, Len(excludeDomain2))) <> LCase(excludeDomain2) Then
                    If InStr(recip.Address, "@") > 0 Then
                        foundOne = True
'                        Debug.Print mai.subject & vbTab & recip.Address
                End If
            Next
        End If
        If foundOne Then Exit For
    Next
    If foundOne Then
        Debug.Print "Need to move folder " & startFolder.FolderPath
'        If movetofolder Is Nothing Then
'            MsgBox "Navigate to the folder where those containing external addresses are to be moved", vbOKOnly, "Move folder"
'            Set movetofolder = Application.GetNamespace("mapi").PickFolder
'        End If
'        startFolder.moveto movetofolder
        
    End If
 
End Sub

Select allOpen in new window

How can i run this code....

How can i run this code....

OOPS partial post!

Sub extemailinFolder()
Dim myfolder As MAPIFolder
Dim movetofolder As Outlook.MAPIFolder
        
        For Each myfolder In Application.GetNamespace("mapi").PickFolder.folders
            recur_extemailinFolder myfolder, movetofolder
        Next
 
End Sub
Sub recur_extemailinFolder(startFolder As MAPIFolder, ByRef movetofolder As MAPIFolder)
Dim fldr As Outlook.MAPIFolder
Dim folderItems As Outlook.items
Dim foundOne As Boolean
Dim recip As Outlook.Recipient
Dim objItem As Object
Dim mai As Outlook.mailitem
'Const excludeDomain1 = "@***.net"
'Const excludeDomain2 = "@*****.com"
 
    foundOne = False
    On Error Resume Next
    
    ' process all the items in this folder
    For Each objItem In startFolder.items
        If TypeName(objItem) = "MailItem" Then
            Set mai = objItem
            For Each recip In mai.Recipients
'                If LCase(Right(recip.Address, Len(excludeDomain1))) <> LCase(excludeDomain1) And _
                    LCase(Right(recip.Address, Len(excludeDomain2))) <> LCase(excludeDomain2) Then
                    If InStr(recip.Address, "@") > 0 Then
                        foundOne = True
'                        Debug.Print mai.subject & vbTab & recip.Address
                End If
            Next
        End If
        If foundOne Then Exit For
    Next
    If foundOne Then
        Debug.Print "Need to move folder " & startFolder.FolderPath
'        If movetofolder Is Nothing Then
'            MsgBox "Navigate to the folder where those containing external addresses are to be moved", vbOKOnly, "Move folder"
'            Set movetofolder = Application.GetNamespace("mapi").PickFolder
'        End If
'        startFolder.moveto movetofolder
        
    End If
 
End Sub

Select allOpen in new window

I dont get anything done. Nothing comes into the immediate window

I dont get anything done. Nothing comes into the immediate window

Made a quick retest ... it works as expected ... which is not say the expectation is correct.

i.e. if there an email in the folder with an "@" symbol therein then it flags it for a move.  I can modify to output every email and see if there is a pattern.

Chris

Sub extemailinFolder()
Dim myfolder As MAPIFolder
Dim movetofolder As Outlook.MAPIFolder
        
        For Each myfolder In Application.GetNamespace("mapi").PickFolder.folders
            recur_extemailinFolder myfolder, movetofolder
        Next
 
End Sub
Sub recur_extemailinFolder(startFolder As MAPIFolder, ByRef movetofolder As MAPIFolder)
Dim fldr As Outlook.MAPIFolder
Dim folderItems As Outlook.items
Dim foundOne As Boolean
Dim recip As Outlook.Recipient
Dim objItem As Object
Dim mai As Outlook.mailitem
'Const excludeDomain1 = "@***.net"
'Const excludeDomain2 = "@*****.com"
 
    foundOne = False
    On Error Resume Next
    
    ' process all the items in this folder
    For Each objItem In startFolder.items
        If TypeName(objItem) = "MailItem" Then
            Set mai = objItem
            For Each recip In mai.Recipients
                debug.print recip.address
'                If LCase(Right(recip.Address, Len(excludeDomain1))) <> LCase(excludeDomain1) And _
                    LCase(Right(recip.Address, Len(excludeDomain2))) <> LCase(excludeDomain2) Then
                    If InStr(recip.Address, "@") > 0 Then
                        foundOne = True
'                        Debug.Print mai.subject & vbTab & recip.Address
                End If
            Next
        End If
        If foundOne Then Exit For
    Next
    If foundOne Then
        Debug.Print "Need to move folder " & startFolder.FolderPath
'        If movetofolder Is Nothing Then
'            MsgBox "Navigate to the folder where those containing external addresses are to be moved", vbOKOnly, "Move folder"
'            Set movetofolder = Application.GetNamespace("mapi").PickFolder
'        End If
'        startFolder.moveto movetofolder
        
    End If
 
End Sub

Select allOpen in new window

Chris i dont get the opoup that asks me to select the folder. But there is some data acumilated in the immediate window

Chris i dont get the opoup that asks me to select the folder. But there is some data acumilated in the immediate window

Yes I did say that I had still suppressed all the move activities whilst we gathered data on what was happening ...

You stated before nothing happened so I presume all the data in teh window compriises lines of addresses either
ogroup/ ... etc
or
fred@fcred.com

Can you advise any pattern and/or other data types presented.

Chris

I do have external mails but just get the local list like this

/O=IGROUP/OU=FIRST ADMINISTRATIVE GROUP/CN=RECIPIENTS/CN=ALG

I do have external mails but just get the local list like this

/O=IGROUP/OU=FIRST ADMINISTRATIVE GROUP/CN=RECIPIENTS/CN=ALG

Sorry but I have to question you :<{

>>> I do have external mails ... the loop should be printing out all recipients adresses.  The only way to exit the loop is all recipients examined OR an external email containing "@" found.

At the point of debug there is no check of the data type so exactly what does the external email present as ... it ought to be visible in some way either bu position or content.

Chris

For the test i have a mail that looks as this
Internal@abc.com

I've just tested again with no problem ... as soon as an email has "@" it triggers the movement ... albeit only with a debug comment currently.

Can you replace your code and retry?

Explicitly do you get the message:
Need to move folder \\...
displayed for folders with an external email therein?

Chris

Sub extemailinFolder()
Dim myfolder As MAPIFolder
Dim movetofolder As Outlook.MAPIFolder
        
        For Each myfolder In Application.GetNamespace("mapi").PickFolder.folders
            recur_extemailinFolder myfolder, movetofolder
        Next
 
End Sub
 
Sub recur_extemailinFolder(startFolder As MAPIFolder, ByRef movetofolder As MAPIFolder)
Dim fldr As Outlook.MAPIFolder
Dim folderItems As Outlook.items
Dim foundOne As Boolean
Dim recip As Outlook.Recipient
Dim objItem As Object
Dim mai As Outlook.mailitem
 
    foundOne = False
    On Error Resume Next
    
    ' process all the items in this folder
    For Each objItem In startFolder.items
        If TypeName(objItem) = "MailItem" Then
            Set mai = objItem
            For Each recip In mai.Recipients
                Debug.Print recip.Address
                    If InStr(recip.Address, "@") > 0 Then
                        foundOne = True
                End If
            Next
        End If
        If foundOne Then Exit For
    Next
    If foundOne Then
        Debug.Print "Need to move folder " & startFolder.FolderPath
'        If movetofolder Is Nothing Then
'            MsgBox "Navigate to the folder where those containing external addresses are to be moved", vbOKOnly, "Move folder"
'            Set movetofolder = Application.GetNamespace("mapi").PickFolder
'        End If
'        startFolder.moveto movetofolder
    End If
 
End Sub

Select allOpen in new window

Chris no luck i dont get the box that asks me to move them.

Is there anything i need to change?
I even ran on my main folder where there are 100's of folders. All names gets logged in the immediate window as mentioned before no external show up.

Chris no luck i dont get the box that asks me to move them.

Is there anything i need to change?
I even ran on my main folder where there are 100's of folders. All names gets logged in the immediate window as mentioned before no external show up.

Are we at cross purposes?

I explicitly stated that the post DOES NOT MOVE the folders as yet, (the logic being to work out errors before trying it in anger.

Instead it records the intent to move the folder in the debug trace.  If there is no record of a movement in the debug trace then we have a misunderstanding.

The script logs all email recipients in a folder until it sees a recipents address with "@" in it.  There is no exception to this and if you do not get an email address as that in your debug it means you do not have an external address that follows that form in there.

You have referred to a recipient with an email address of Internal@abc.com.  How does that addressee feature in the debug trace?  It must be represented differently somehow and once we know how we can hopefully correct the error.

I can of course be wrong somehow but I genuinely can't see how so I think there must be some kind of misunderstanding.

Chris

Chris i have no idea what i am doing wrong

I have your code in a module with no changes
I have 3 folders below the Inbox
1 has an external mail. I have the EE mail in it
noreply remove this @experts-exchange.com
I have 2 folders and they have my internal local mails.

So in this senario shouldnt the code trigger the move?

Chris i have no idea what i am doing wrong

I have your code in a module with no changes
I have 3 folders below the Inbox
1 has an external mail. I have the EE mail in it
noreply remove this @experts-exchange.com
I have 2 folders and they have my internal local mails.

So in this senario shouldnt the code trigger the move?

>>> Chris i have no idea what i am doing wrong
    Who said you are doing something wrong ... with these complex questions they take a lot of refinement to get understanding, though I try to get as much as I can up front.

Yes ... but only if noting mention to the inbox if noreply remove this @experts-exchange.com is a recipient rather than the sender

>>> "Just the first To mail id.".

Chris

What a fool i am
I had the internal mails right but had the external received mail
Sorry for that
Now i get the mail id as
Mail@abc.com
in the immediate window

What a fool i am
I had the internal mails right but had the external received mail
Sorry for that
Now i get the mail id as
Mail@abc.com
in the immediate window

It works :-)
But testing it on my main set of folders... Will get back....

Thank U worked perfect...

:-)))\

Phew!