?
Solved

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

Posted on 2009-04-15
52
Medium Priority
?
273 Views
Last Modified: 2012-05-06
Hi,

Move all Outlook folders that has 1 or more than 1 external email's.
i have 10,000 + folders that has mails . They are all sent mails. So i need a script that can query by External email addresses not my local exchange mails and move all folders to a predefined path. Need to Query the sender name thats the mail id i used to sent a mail to a person. Just the first To mail id.
And move the folders to a path

So i can have all the folders that have external mails in 1 folder.

Regards
Sharath
0
Comment
Question by:bsharath
  • 30
  • 20
  • +1
52 Comments
 
LVL 28

Expert Comment

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

0
 
LVL 45

Expert Comment

by:patrickab
ID: 24214466
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
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 24248034
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
0
What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

 
LVL 11

Author Comment

by:bsharath
ID: 24248062
Hi Chris...
Sent a mail to you....
0
 
LVL 11

Author Comment

by:bsharath
ID: 24248065
Hi Chris...
Sent a mail to you....
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 24248262
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
0
 
LVL 11

Author Comment

by:bsharath
ID: 24248274
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
0
 
LVL 11

Author Comment

by:bsharath
ID: 24248275
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
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 24257530
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
0
 
LVL 11

Author Comment

by:bsharath
ID: 24257580
No folder will have sub folder'
I have the structure as this

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

There will be subfolders.
0
 
LVL 11

Author Comment

by:bsharath
ID: 24257581
No folder will have sub folder'
I have the structure as this

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

There will be subfolders.
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 24257643
ANd I guess you want to exclude trhe sent folder itself and only work this on teh sub folders 1 .. n?

Chris
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 24257739
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

Open in new window

0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 24257820
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
0
 
LVL 11

Author Comment

by:bsharath
ID: 24257836
:-(

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
0
 
LVL 11

Author Comment

by:bsharath
ID: 24257838
:-(

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
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 24257883
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

Open in new window

0
 
LVL 11

Author Comment

by:bsharath
ID: 24257921
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

Open in new window

0
 
LVL 11

Author Comment

by:bsharath
ID: 24257922
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

Open in new window

0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 24257964
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
0
 
LVL 11

Author Comment

by:bsharath
ID: 24257980
Ok can try that...

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

Author Comment

by:bsharath
ID: 24257981
Ok can try that...

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

Expert Comment

by:Chris Bottomley
ID: 24258018
>>> With group i need to add some other data

Can you give some kind of clue?

Chris
0
 
LVL 11

Author Comment

by:bsharath
ID: 24258024
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
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 24258054
No worries ... I think

Be back soon with a change

Chris
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 24258069
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

Open in new window

0
 
LVL 11

Author Comment

by:bsharath
ID: 24258094
How can i run this code....
0
 
LVL 11

Author Comment

by:bsharath
ID: 24258095
How can i run this code....
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 24258116
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

Open in new window

0
 
LVL 11

Author Comment

by:bsharath
ID: 24258143
I dont get anything done. Nothing comes into the immediate window
0
 
LVL 11

Author Comment

by:bsharath
ID: 24258144
I dont get anything done. Nothing comes into the immediate window
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 24258475
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

Open in new window

0
 
LVL 11

Author Comment

by:bsharath
ID: 24258539
Chris i dont get the opoup that asks me to select the folder. But there is some data acumilated in the immediate window
0
 
LVL 11

Author Comment

by:bsharath
ID: 24258540
Chris i dont get the opoup that asks me to select the folder. But there is some data acumilated in the immediate window
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 24259147
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
0
 
LVL 11

Author Comment

by:bsharath
ID: 24259210
I do have external mails but just get the local list like this

/O=IGROUP/OU=FIRST ADMINISTRATIVE GROUP/CN=RECIPIENTS/CN=ALG
0
 
LVL 11

Author Comment

by:bsharath
ID: 24259211
I do have external mails but just get the local list like this

/O=IGROUP/OU=FIRST ADMINISTRATIVE GROUP/CN=RECIPIENTS/CN=ALG
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 24260521
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
0
 
LVL 11

Author Comment

by:bsharath
ID: 24260635
For the test i have a mail that looks as this
Internal@abc.com
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 24260756
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

Open in new window

0
 
LVL 11

Author Comment

by:bsharath
ID: 24260842
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.
0
 
LVL 11

Author Comment

by:bsharath
ID: 24260843
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.
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 24261192
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
0
 
LVL 11

Author Comment

by:bsharath
ID: 24262050
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?

0
 
LVL 11

Author Comment

by:bsharath
ID: 24262051
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?

0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 24262363
>>> 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
0
 
LVL 11

Author Comment

by:bsharath
ID: 24262558
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
0
 
LVL 11

Author Comment

by:bsharath
ID: 24262559
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
0
 
LVL 59

Accepted Solution

by:
Chris Bottomley earned 2000 total points
ID: 24262858
Re-enabling the physical move then gives the following code

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

Open in new window

0
 
LVL 11

Author Comment

by:bsharath
ID: 24263029
It works :-)
But testing it on my main set of folders... Will get back....
0
 
LVL 11

Author Comment

by:bsharath
ID: 24263243
Thank U worked perfect...

:-)))\
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 24263301
Phew!
0

Featured Post

Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Windows Explorer lets you open cabinet (cab) files like any other folder. In VBA you can easily handle normal files and folders, but opening and indeed creating cabinet files takes a lot more - and that's you'll find here.
There can be many situations demanding the conversion of Outlook OST files to PST format and as such, there is no shortage of automated tools to perform this conversion. However, what makes Stellar OST to PST converter stand above the rest? Let us e…
There are cases when e.g. an IT administrator wants to have full access and view into selected mailboxes on Exchange server, directly from his own email account in Outlook or Outlook Web Access. This proves useful when for example administrator want…
Whether it be Exchange Server Crash Issues, Dirty Shutdown Errors or Failed to mount error, Stellar Phoenix Mailbox Exchange Recovery has always got your back. With the help of its easy to understand user interface and 3 simple steps recovery proced…
Suggested Courses

850 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question