Go Premium for a chance to win a PS4. Enter to Win

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 1217
  • Last Modified:

Move all mails from all folders in outlook to inbox.

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
bsharath
Asked:
bsharath
  • 11
  • 9
1 Solution
 
Chris BottomleyCommented:
Do you really mean all folders or do you mean all folders off the inbox?

Chris
0
 
Chris BottomleyCommented:
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
 
bsharathAuthor Commented:
Can i use this macro for this design

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

0
Windows Server 2016: All you need to know

Learn about Hyper-V features that increase functionality and usability of Microsoft Windows Server 2016. Also, throughout this eBook, you’ll find some basic PowerShell examples that will help you leverage the scripts in your environments!

 
Chris BottomleyCommented:
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
 
bsharathAuthor Commented:
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
 
Chris BottomleyCommented:
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
 
bsharathAuthor Commented:
Is there anything i need to change in the macro.
Where should i mention the excluded folder.?
0
 
Chris BottomleyCommented:
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
 
Chris BottomleyCommented:
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
 
bsharathAuthor Commented:
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
 
bsharathAuthor Commented:
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
 
Chris BottomleyCommented:
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
 
bsharathAuthor Commented:
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
 
Chris BottomleyCommented:
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
 
bsharathAuthor Commented:
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
 
bsharathAuthor Commented:
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
 
Chris BottomleyCommented:
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
 
Chris BottomleyCommented:
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
 
bsharathAuthor Commented:
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
 
Chris BottomleyCommented:
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.

  • 11
  • 9
Tackle projects and never again get stuck behind a technical roadblock.
Join Now