Solved

Move all mails from all folders in outlook to inbox.

Posted on 2007-12-05
20
1,169 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
Comment Utility
Do you really mean all folders or do you mean all folders off the inbox?

Chris
0
 
LVL 59

Expert Comment

by:Chris Bottomley
Comment Utility
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
Comment Utility
Can i use this macro for this design

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

0
 
LVL 59

Expert Comment

by:Chris Bottomley
Comment Utility
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
Comment Utility
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
Comment Utility
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
Comment Utility
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
Comment Utility
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
Comment Utility
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
Comment Utility
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
Top 6 Sources for Identifying Threat Actor TTPs

Understanding your enemy is essential. These six sources will help you identify the most popular threat actor tactics, techniques, and procedures (TTPs).

 
LVL 11

Author Comment

by:bsharath
Comment Utility
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
Comment Utility
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
Comment Utility
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
Comment Utility
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
Comment Utility
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
Comment Utility
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
Comment Utility
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
Comment Utility
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
Comment Utility
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
Comment Utility
Phew! Glad we got there.
0

Featured Post

IT, Stop Being Called Into Every Meeting

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

Join & Write a Comment

Email signatures have numerous marketing benefits. Here are 8 top reasons to turn your email signature into a marketing channel.
Create high volume marketing opportunities using email signatures with these top 10 DOs and DON'Ts of email signature marketing.
Get people started with the process of using Access VBA to control Outlook using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Microsoft Outlook. Using automation, an Access applic…
This video shows how to remove a single email address from the Outlook 2010 Auto Suggestion memory. NOTE: For Outlook 2016 and 2013 perform the exact same steps. Open a new email: Click the New email button in Outlook. Start typing the address: …

743 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

10 Experts available now in Live!

Get 1:1 Help Now