Solved

Move all mails from all folders in outlook to inbox.

Posted on 2007-12-05
20
1,174 Views
Last Modified: 2010-04-21
Hi,

Move all mails from all folders in outlook to inbox.I need to move all of them which are scattered in many folders and sub folders as i got a Macro from Chris to create folders according to users and moving them automatically.So first need to gather all the mails no matter in which folder they are to inbox.

REgards
Sharath
0
Comment
Question by:bsharath
  • 11
  • 9
20 Comments
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 20410579
Do you really mean all folders or do you mean all folders off the inbox?

Chris
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 20410734
Assuming you mean all folders off the inbox then try the attached

Chris
Sub launchpad()

 

Dim olApp As Outlook.Application

Dim objNS As Outlook.NameSpace

Dim MyFolder As Outlook.MAPIFolder

    On Error Resume Next

    

    Set olApp = Outlook.Application

    Set objNS = olApp.GetNamespace("MAPI")

    Set MyFolder = objNS.GetDefaultFolder(olFolderInbox)

    Call ProcessFolder(MyFolder)

    Set objNS = Nothing

 

Set MyFolder = Nothing

Set olApp = Nothing

Set objNS = Nothing

 

End Sub

 

 

Sub ProcessFolder(StartFolder As MAPIFolder)

Dim objFolder As Outlook.MAPIFolder

Dim objItem As Object

Dim mai As mailitem

Dim itemIndex As Long

    On Error Resume Next
 

    For itemIndex = StartFolder.Items.Count To 1 Step -1

        If StartFolder.FolderPath <> Outlook.Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).FolderPath Then

            Set objItem = StartFolder.Items(itemIndex)

'            Debug.Print StartFolder.FolderPath & "\" & objItem.Subject

            objItem.Move Outlook.Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)

        End If

    Next

        

    ' process all the subfolders of this folder

    For Each objFolder In StartFolder.Folders

        Call ProcessFolder(objFolder)

    Next

 

Set mai = Nothing

Set objFolder = Nothing

Set objItem = Nothing

End Sub

Open in new window

0
 
LVL 11

Author Comment

by:bsharath
ID: 20410937
Can i use this macro for this design

Pst file
   > Inbox
    >> Folder1
> Folder2
  >> Folder3
>>> folder 4

0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 20411033
Not currently, but a tweak is viable ... need to be able to identify the folder root, i.e. if the root is personal folder then a simple nested search would pick up the deleted, drafts, inbox, outbox and sent item folders.

Specific folders can be excluded as long as they are known i.e. a mod to check if current folder is:

deleted or drafts or outbox or sent item folders could be made.

You need to identify if this change will cover all folders of interest and exclude all others.  Note the macro will iterate through all subfolders of any folder unless explicitly excluded as above.

Chris
0
 
LVL 11

Author Comment

by:bsharath
ID: 20411093
Chris that is right we need to exclusclude some folders before we run.Especially sent.
Can you change the macro a bit that it only moves all mails from all folders inside inbox also.So that the others are excluded.
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 20411370
Okay, modified as as attached.  Check th e excluded directories in the script, for instance you could have antivirus holding folders that should be excluded as well.  The principle of operation of the script as modified does however copy all emails from folders of type email to inbox with the exception of those mentioned above.

Chris
Sub launchpad()

 

Dim olApp As Outlook.Application

Dim objNS As Outlook.NameSpace

Dim MyFolder As Outlook.MAPIFolder

    On Error Resume Next

    

    Set olApp = Outlook.Application

    Set objNS = olApp.GetNamespace("MAPI")

    Set MyFolder = objNS.Folders.Item("personal folders")

    Call ProcessFolder(MyFolder)

    Set objNS = Nothing

 

Set MyFolder = Nothing

Set olApp = Nothing

Set objNS = Nothing

 

End Sub

 

 

Sub ProcessFolder(StartFolder As MAPIFolder)

Dim objFolder As Outlook.MAPIFolder

Dim objItem As Object

Dim mai As mailitem

Dim itemIndex As Long

    On Error Resume Next
 

    For itemIndex = StartFolder.Items.Count To 1 Step -1

        If StartFolder.FolderPath <> Outlook.Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).FolderPath And _

            StartFolder.FolderPath <> Outlook.Application.GetNamespace("MAPI").GetDefaultFolder(olFolderDeletedItems).FolderPath And _

            StartFolder.DefaultItemType = olMailItem And _

            StartFolder.FolderPath <> Outlook.Application.GetNamespace("MAPI").GetDefaultFolder(olFolderDrafts).FolderPath And _

            StartFolder.FolderPath <> Outlook.Application.GetNamespace("MAPI").GetDefaultFolder(olFolderOutbox).FolderPath And _

            StartFolder.FolderPath <> Outlook.Application.GetNamespace("MAPI").GetDefaultFolder(olFolderSentMail).FolderPath _

            Then

            Set objItem = StartFolder.Items(itemIndex)

'            Debug.Print StartFolder.FolderPath & "\" & objItem.Subject & vbTab & StartFolder.DefaultItemType

            objItem.Move Outlook.Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)

        End If

    Next

        

    ' process all the subfolders of this folder

    For Each objFolder In StartFolder.Folders

        If StartFolder.FolderPath <> Outlook.Application.GetNamespace("MAPI").GetDefaultFolder(olFolderDeletedItems).FolderPath And _

            StartFolder.DefaultItemType = olMailItem And _

            StartFolder.FolderPath <> Outlook.Application.GetNamespace("MAPI").GetDefaultFolder(olFolderDrafts).FolderPath And _

            StartFolder.FolderPath <> Outlook.Application.GetNamespace("MAPI").GetDefaultFolder(olFolderOutbox).FolderPath And _

            StartFolder.FolderPath <> Outlook.Application.GetNamespace("MAPI").GetDefaultFolder(olFolderSentMail).FolderPath _

            Then

                Call ProcessFolder(objFolder)

        End If

    Next

 

Set mai = Nothing

Set objFolder = Nothing

Set objItem = Nothing

End Sub

Open in new window

0
 
LVL 11

Author Comment

by:bsharath
ID: 20411473
Is there anything i need to change in the macro.
Where should i mention the excluded folder.?
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 20411761
I understand the concept I hav eapplied so if you advise the path of any extra folders to exclude then post them here and i'll make the necessary mods ... i.e. the changes vary according to whether they are a top level folder or a sub folder.

Chris
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 20411810
If you run the following then it will provide a map of all folders in the debug window ... if it helps!

Chris
Sub launchpad()

 

Dim olApp As Outlook.Application

Dim objNS As Outlook.NameSpace

Dim MyFolder As Outlook.MAPIFolder

    On Error Resume Next

    

    Set olApp = Outlook.Application

    Set objNS = olApp.GetNamespace("MAPI")

    Set MyFolder = objNS.Folders.Item("personal folders")

    Call ProcessFolder(MyFolder)

    Set objNS = Nothing

 

Set MyFolder = Nothing

Set olApp = Nothing

Set objNS = Nothing

 

End Sub

 

 

Sub ProcessFolder(StartFolder As MAPIFolder)

Dim objFolder As Outlook.MAPIFolder

Dim objItem As Object

Dim mai As mailitem

Dim itemIndex As Long

    On Error Resume Next
 

    Debug.Print StartFolder.FolderPath & vbTab & StartFolder.DefaultItemType

        

    ' process all the subfolders of this folder

    For Each objFolder In StartFolder.Folders

        Call ProcessFolder(objFolder)

    Next

 

Set mai = Nothing

Set objFolder = Nothing

Set objItem = Nothing

End Sub

Open in new window

0
 
LVL 11

Author Comment

by:bsharath
ID: 20411843
I just need to exclude the fiolder
>Inbox
DELL (All the sub folders)
DELL Logs (ALL the sub folders)
Exchange (All the sub folders)Sophos
Sophos Call center

Need to exclude all the above folders below inbox and all the folders have many sub folders.
0
Control application downtime with dependency maps

Visualize the interdependencies between application components better with Applications Manager's automated application discovery and dependency mapping feature. Resolve performance issues faster by quickly isolating problematic components.

 
LVL 11

Author Comment

by:bsharath
ID: 20412004
I tried this.
If you run the following then it will provide a map of all folders in the debug window ... if it helps!

But nothing happened...
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 20413667
Sorry but I am somewhat confused ... so to clarify

You want to run the process from the personal folder level and therefore need to exclude the outbox etc.  (The alternative is to run it from the inbox if there are no mail folders at the same level).  Hopefully this is addressed already.

Within the inbox you want to exclude certain folders.  I ask because the latest post suggested only the inbox was relevant, (possibly because we already excluded the others but want to ask to get clarity).  Will need to add this when I am clear.

folders off the inbox to be excluded are:

inbox/dell/*.*
inbox/dell logs/*.*
inbox/exchange/*.*
inbox/sopohos\*.*
inbox/spohos call centre

Chris
0
 
LVL 11

Author Comment

by:bsharath
ID: 20417056
Yes Chris...

You need to exclude all these folders below INBOX

inbox/dell/*.*
inbox/dell logs/*.*
inbox/exchange/*.*
inbox/sopohos\*.*
inbox/spohos call centre

0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 20417966
Sharath, the following has been tested on my pc and seems to work ok.  It is not tested exactly as is due to the difference in pst files.

Please look it over and then try it.

Chris
Option Explicit
 

Sub launchpad()

 

Dim olApp As Outlook.Application

Dim objNS As Outlook.NameSpace

Dim MyFolder As Outlook.MAPIFolder

    On Error Resume Next

    

    Set olApp = Outlook.Application

    Set objNS = olApp.GetNamespace("MAPI")

    Set MyFolder = objNS.Folders.Item("personal folders")

    Call ProcessFolder(MyFolder)

    Set objNS = Nothing

 

Set MyFolder = Nothing

Set olApp = Nothing

Set objNS = Nothing

 

End Sub

 

 

Sub ProcessFolder(StartFolder As MAPIFolder)

Dim objFolder As Outlook.MAPIFolder

Dim objItem As Object

Dim mai As mailitem

Dim itemIndex As Long

    On Error Resume Next
 

    If StartFolder.FolderPath <> Outlook.Application.GetNamespace("MAPI").GetDefaultFolder(olFolderDeletedItems).FolderPath And _

        StartFolder.DefaultItemType = olMailItem And _

        StartFolder.FolderPath <> Outlook.Application.GetNamespace("MAPI").GetDefaultFolder(olFolderDrafts).FolderPath And _

        StartFolder.FolderPath <> Outlook.Application.GetNamespace("MAPI").GetDefaultFolder(olFolderOutbox).FolderPath And _

        StartFolder.FolderPath <> Outlook.Application.GetNamespace("MAPI").GetDefaultFolder(olFolderSentMail).FolderPath _

        Then

            If StartFolder.FolderPath <> Outlook.Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).FolderPath Then

                For itemIndex = StartFolder.Items.Count To 1 Step -1

                    Set objItem = StartFolder.Items(itemIndex)

                    objItem.Move Outlook.Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)

                Next

            End If

            For Each objFolder In StartFolder.Folders

                If objFolder.FolderPath <> Outlook.Application.GetNamespace("MAPI").GetDefaultFolder(olFolderDeletedItems).FolderPath And _

                    objFolder.DefaultItemType = olMailItem And _

                    objFolder.FolderPath <> Outlook.Application.GetNamespace("MAPI").GetDefaultFolder(olFolderDrafts).FolderPath And _

                    objFolder.FolderPath <> Outlook.Application.GetNamespace("MAPI").GetDefaultFolder(olFolderOutbox).FolderPath And _

                    objFolder.FolderPath <> Outlook.Application.GetNamespace("MAPI").GetDefaultFolder(olFolderSentMail).FolderPath And _

                    objFolder.FolderPath <> "\\Personal Folders\Inbox\Dell" And _

                    objFolder.FolderPath <> "\\Personal Folders\Inbox\Dell Logs" And _

                    objFolder.FolderPath <> "\\Personal Folders\Inbox\Exchange" And _

                    objFolder.FolderPath <> "\\Personal Folders\Inbox\Sophos" And _

                    objFolder.FolderPath <> "\\Personal Folders\Inbox\Sophos Call Centre" _

                    Then

                        Call ProcessFolder(objFolder)

                End If

            Next

    End If

 

Set mai = Nothing

Set objFolder = Nothing

Set objItem = Nothing

End Sub

Open in new window

0
 
LVL 11

Author Comment

by:bsharath
ID: 20418057
Chris thanks...
Shall check and post back
Did you have time to check on this

http://www.experts-exchange.com/Software/Office_Productivity/Groupware/Outlook/Q_22997561.html
0
 
LVL 11

Author Comment

by:bsharath
ID: 20421340
Chris..the script just finished running.It took a lot of time to move all mails to the inbox.But a small problem.The macro moves all mails to the Server inbox.Any way change it to move to the pst Mailbox.
As moving 8gb to the server and back woul take hrs of time and the space on the server is also limited.
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 20422118
I presume you have been working with a copy of the mailbox so all you want to do is modify the script to point to the pst inbox?

I am however confused as the previous script for 20+ emails used the exact same definition for the inbox as this one therefore the previous inbox as used for the source data should have the same inbox used for the destination data.

Unfortunately I need access to a server implementation to see how to ensure I differentiate correctly between the two so I cant do that till the morning ... I hope.

Chris
0
 
LVL 59

Accepted Solution

by:
Chris Bottomley earned 500 total points
ID: 20422532
Sorry ... just been thinking about something else I did and to ensure the move occurs ok should be easy as attached:

The nature of the change is to replace the standard folder for inbox with a definitive path calculated off the personal folder which for efficiency is passed in at the start, (i.e. calculated once).

You can set a break point after the copy line if you want, (I assume you are comfortable with this) to check the mail appears in the correct folder efore leaving it to run free

Chris
Option Explicit
 

Sub launchpad()

 

Dim olApp As Outlook.Application

Dim objNS As Outlook.NameSpace

Dim MyFolder As Outlook.MAPIFolder

Dim tgtFolder As Outlook.MAPIFolder

Dim olFolder As Outlook.Folders

    On Error Resume Next

    

    Set olApp = Outlook.Application

    Set objNS = olApp.GetNamespace("MAPI")

    Set MyFolder = objNS.Folders.Item("personal folders")

    Set tgtFolder = objNS.Folders.Item("personal folders")

    Set olFolder = tgtFolder.Folders

    Set tgtFolder = olFolder.Item("Inbox")

    Call ProcessFolder(MyFolder, tgtFolder)

    Set objNS = Nothing

 

Set MyFolder = Nothing

Set olApp = Nothing

Set objNS = Nothing

 

End Sub

 

 

Sub ProcessFolder(StartFolder As MAPIFolder, destFolder As MAPIFolder)

Dim objFolder As Outlook.MAPIFolder

Dim objItem As Object

Dim mai As mailitem

Dim itemIndex As Long

    On Error Resume Next
 

    If StartFolder.FolderPath <> Outlook.Application.GetNamespace("MAPI").GetDefaultFolder(olFolderDeletedItems).FolderPath And _

        StartFolder.DefaultItemType = olMailItem And _

        StartFolder.FolderPath <> Outlook.Application.GetNamespace("MAPI").GetDefaultFolder(olFolderDrafts).FolderPath And _

        StartFolder.FolderPath <> Outlook.Application.GetNamespace("MAPI").GetDefaultFolder(olFolderOutbox).FolderPath And _

        StartFolder.FolderPath <> Outlook.Application.GetNamespace("MAPI").GetDefaultFolder(olFolderSentMail).FolderPath _

        Then

            If StartFolder.FolderPath <> Outlook.Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).FolderPath Then

                For itemIndex = StartFolder.Items.Count To 1 Step -1

                    Set objItem = StartFolder.Items(itemIndex)

                    objItem.Move destFolder

                Next

            End If

            For Each objFolder In StartFolder.Folders

                If objFolder.FolderPath <> Outlook.Application.GetNamespace("MAPI").GetDefaultFolder(olFolderDeletedItems).FolderPath And _

                    objFolder.DefaultItemType = olMailItem And _

                    objFolder.FolderPath <> Outlook.Application.GetNamespace("MAPI").GetDefaultFolder(olFolderDrafts).FolderPath And _

                    objFolder.FolderPath <> Outlook.Application.GetNamespace("MAPI").GetDefaultFolder(olFolderOutbox).FolderPath And _

                    objFolder.FolderPath <> Outlook.Application.GetNamespace("MAPI").GetDefaultFolder(olFolderSentMail).FolderPath And _

                    objFolder.FolderPath <> "\\Personal Folders\Inbox\Dell" And _

                    objFolder.FolderPath <> "\\Personal Folders\Inbox\Dell Logs" And _

                    objFolder.FolderPath <> "\\Personal Folders\Inbox\Exchange" And _

                    objFolder.FolderPath <> "\\Personal Folders\Inbox\Sophos" And _

                    objFolder.FolderPath <> "\\Personal Folders\Inbox\Sophos Call Centre" _

                    Then

                        Call ProcessFolder(objFolder, destFolder)

                End If

            Next

    End If

 

Set mai = Nothing

Set objFolder = Nothing

Set objItem = Nothing

End Sub

Open in new window

0
 
LVL 11

Author Closing Comment

by:bsharath
ID: 31412819
Thanks a lot Chris you have helped me so much.I even showed this to my friends and every one wanted the macro.You have been very helpful.Appretiate the help...Thanks.
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 20425765
Phew! Glad we got there.
0

Featured Post

Efficient way to get backups off site to Azure

This user guide provides instructions on how to deploy and configure both a StoneFly Scale Out NAS Enterprise Cloud Drive virtual machine and Veeam Cloud Connect in the Microsoft Azure Cloud.

Question has a verified solution.

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

Large Outlook files lead to various unwanted errors and corruption issues. Furthermore, large outlook files can also make Outlook take longer to start-up, search, navigate, and shut-down. So, In this article, i will discuss a method to make your Out…
Read this checklist to learn more about the 15 things you should never include in an email signature.
This Experts Exchange video Micro Tutorial shows how to tell Microsoft Office that a word is NOT spelled correctly. Microsoft Office has a built-in, main dictionary that is shared by Office apps, including Excel, Outlook, PowerPoint, and Word. When …
To add imagery to an HTML email signature, you have two options available to you. You can either add a logo/image by embedding it directly into the signature or hosting it externally and linking to it. The vast majority of email clients display l…

863 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

Need Help in Real-Time?

Connect with top rated Experts

21 Experts available now in Live!

Get 1:1 Help Now