?
Solved

Move 7 folders data to another 7 locations when macro run. Outlook Macro that can do this.

Posted on 2010-01-12
30
Medium Priority
?
198 Views
Last Modified: 2012-05-08
Hi,

Move 7 folders data to another 7 locations when macro run. Outlook Macro that can do this.

I have these folders in this path

Mailbox -Sharath\Inbox\Sop1
Mailbox -Sharath\Inbox\Sop2
Mailbox -Sharath\Inbox\Sop 12
Mailbox -Sharath\Inbox\Sop3
Mailbox -Sharath\Inbox\Sop4
Mailbox -Sharath\Inbox\Sop5
Mailbox -Sharath\Inbox\Sop6

When right click and run macro i want each folder mails only to be moved to another location in a pst whose path is defined in the macro. I want to verify each folder email then move them later. So in this position i cannot use a direct rule.

Regards
Sharath

0
Comment
Question by:bsharath
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 15
  • 15
30 Comments
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 26377168
When you right click on an individual folder identified above all mails therein are to be moved to a specific folder, but only from the specific folder selected?

Chris
0
 
LVL 11

Author Comment

by:bsharath
ID: 26377192
Hi Chris
The from folder and to folder needs to be defined in the code...
So when i right click andy folder and say "Move 7" all the 7 folders data has to be moved to another 7 folders in respective pst as mentioned in code
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 26378088
How are the 7 destination folders identified, by the same names as the original folders just a different root or something else?

Chris
0
Get your Disaster Recovery as a Service basics

Disaster Recovery as a Service is one go-to solution that revolutionizes DR planning. Implementing DRaaS could be an efficient process, easily accessible to non-DR experts. Learn about monitoring, testing, executing failovers and failbacks to ensure a "healthy" DR environment.

 
LVL 11

Author Comment

by:bsharath
ID: 26378110
Each folder will have different paths like
All will be in this path
\\Mailbox - Sharat\inbox

But the destinations will be
\\All mails\Somename
\\All mails\Somename

\\Dated\Somename


0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 26389640
Can you upload your thisoutlooksession code so I can add the support for the feature ... ideally please identify the legend you want in the menu for example: "Move 7 Folders"

Chris
0
 
LVL 11

Author Comment

by:bsharath
ID: 26390967
Emailed you the code

we can have as "Move 7 folders"
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 26391060
As ever sub olkNav2Folder is included for completeness but if there is already a copy in the module it should be left out.

Chris
Sub Q25048313()
Dim RootFolder As Object
Dim ProcessFolder As Object
Dim DestFolder As Object
Dim strRootFolder As Object
Dim strSourceFolders As String
Dim strProcessFolder As Variant
Dim itm As Object
Dim itmCount As Integer
Const strSop1Moveto As String = "\\personal folders\testmoves\Sop1"
Const strSop2Moveto As String = "\\personal folders\testmoves\Sop1"
Const strSop12Moveto As String = "\\personal folders\testmoves\Sop1"
Const strSop3Moveto As String = "\\personal folders\testmoves\Sop1"
Const strSop4Moveto As String = "\\personal folders\testmoves\Sop1"
Const strSop5Moveto As String = "\\personal folders\testmoves\Sop1"
Const strSop6Moveto As String = "\\personal folders\testmoves\Sop1"
    
    #If cbPC Then
        Set strRootFolder = Application.Session.folders("Personal Folders").folders("inbox")
    #Else
        Set strRootFolder = Application.Session.folders("Mailbox -Sharath").folders("inbox")
    #End If
    strSourceFolders = "Sop1, Sop2, Sop 12, Sop3, SOp4, Sop5, Sop6"
    For Each strProcessFolder In Split(Replace(strSourceFolders, ", ", ","), ",")
        Set ProcessFolder = strRootFolder.folders(strProcessFolder)
        Select Case LCase(strProcessFolder)
            Case "sop1"
                Set DestFolder = olkNav2Folder(strSop1Moveto, True)
            Case "sop2"
                Set DestFolder = olkNav2Folder(strSop2Moveto, True)
            Case "sop 12"
                Set DestFolder = olkNav2Folder(strSop12Moveto, True)
            Case "sop3"
                Set DestFolder = olkNav2Folder(strSop3Moveto, True)
            Case "sop4"
                Set DestFolder = olkNav2Folder(strSop4Moveto, True)
            Case "sop5"
                Set DestFolder = olkNav2Folder(strSop5Moveto, True)
            Case "sop6"
                Set DestFolder = olkNav2Folder(strSop6Moveto, True)
            Case Else
                MsgBox "Unexpected Folder detected"
        End Select
        For itmCount = ProcessFolder.items.count To 1 Step -1
            ProcessFolder.items(itmCount).Move DestFolder
        Next
    Next
    
End Sub

Public Function olkNav2Folder(foldername As String, Optional createFolders As Boolean) As Object
Dim olApp As Object
Dim olNS As Object
Dim olfldr As Object
Dim reqdFolder As Object
Dim arrFolders() As String
Dim nestCount As Integer

    On Error Resume Next
    foldername = Replace(Replace(foldername, "/", "\"), "\\", "")
    If Right(foldername, 1) = "\" Then foldername = Left(foldername, Len(foldername) - 1)
    arrFolders() = Split(foldername, "\")
    Set olApp = CreateObject("Outlook.Application")
    Set olNS = olApp.GetNamespace("MAPI")
    Set reqdFolder = olNS.folders.Item(arrFolders(0))
    For nestCount = 1 To UBound(arrFolders)
        If Not reqdFolder Is Nothing Then
            Set olfldr = reqdFolder.folders
            Set reqdFolder = olfldr.Item(arrFolders(nestCount))
            If reqdFolder <> olfldr.Item(arrFolders(nestCount)) Then
                If createFolders Then
                    reqdFolder.folders.Add (arrFolders(nestCount))
                    Set olfldr = reqdFolder.folders
                    Set reqdFolder = olfldr.Item(arrFolders(nestCount))
                Else
                    Set reqdFolder = Nothing
                    Exit For
                End If
            End If
        Else
        End If
    Next
    Set olkNav2Folder = reqdFolder
    Set olApp = Nothing
    Set olNS = Nothing
    Set olfldr = Nothing
    Set reqdFolder = Nothing
End Function

Open in new window

0
 
LVL 11

Author Comment

by:bsharath
ID: 26391072
Chris should i change these lines...

Const strSop1Moveto As String = "\\personal folders\testmoves\Sop1"
Const strSop2Moveto As String = "\\personal folders\testmoves\Sop1"
Const strSop12Moveto As String = "\\personal folders\testmoves\Sop1"
Const strSop3Moveto As String = "\\personal folders\testmoves\Sop1"
Const strSop4Moveto As String = "\\personal folders\testmoves\Sop1"
Const strSop5Moveto As String = "\\personal folders\testmoves\Sop1"
Const strSop6Moveto As String = "\\personal folders\testmoves\Sop1"
     
    #If cbPC Then
        Set strRootFolder = Application.Session.Folders("Personal Folders").Folders("inbox")
    #Else
        Set strRootFolder = Application.Session.Folders("Mailbox -Sharath").Folders("inbox")
    #End If
    strSourceFolders = "Sop1, Sop2, Sop 12, Sop3, SOp4, Sop5, Sop6"

Can you please tell me what has to be updated...
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 26391087
Const strSop1Moveto As String = "\\personal folders\testmoves\Sop1"
Const strSop2Moveto As String = "\\personal folders\testmoves\Sop1"
Const strSop12Moveto As String = "\\personal folders\testmoves\Sop1"
Const strSop3Moveto As String = "\\personal folders\testmoves\Sop1"
Const strSop4Moveto As String = "\\personal folders\testmoves\Sop1"
Const strSop5Moveto As String = "\\personal folders\testmoves\Sop1"
Const strSop6Moveto As String = "\\personal folders\testmoves\Sop1"
All need to be changed to reference the destination folders for each of the '7' folders.

    #If cbPC Then
        Set strRootFolder = Application.Session.Folders("Personal Folders").Folders("inbox")
    #Else
        Set strRootFolder = Application.Session.Folders("Mailbox -Sharath").Folders("inbox")
    #End If
DOES NOT need changing it will work without alteration and makes debugging easier if kept.

    strSourceFolders = "Sop1, Sop2, Sop 12, Sop3, SOp4, Sop5, Sop6"
DOES NOT need changing it saved declaring seven similarly named subfolders for the source folders.

Note also I was over-zealous with cut and paste so I have mailed the modified thisOutlookSession code again.

Chris
0
 
LVL 11

Author Comment

by:bsharath
ID: 26391099
I just changes as this

Const strSop1Moveto As String = "\\All Mails\Inbox\Delivered&Read"
Const strSop2Moveto As String = "\\All Mails\Inbox\File server"
Const strSop12Moveto As String = "\\All Mails\Inbox\ICT"
Const strSop3Moveto As String = "\\All Mails\Inbox\Ram"
Const strSop4Moveto As String = "\\All Mails\Inbox\Scs"
Const strSop5Moveto As String = "\\All Mails\Inbox\Sophos"
Const strSop6Moveto As String = "\\All Mails\Inbox\External senders"
     
    #If cbPC Then
        Set strRootFolder = Application.Session.Folders("All Mails").Folders("inbox")
    #Else
        Set strRootFolder = Application.Session.Folders("Mailbox -Sharath").Folders("inbox")
    #End If
    strSourceFolders = "Delivered&Read,File server,ICT,Ram,Scs,Sophos,External Senders"

Is this right
As it does not work...
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 26391120
   strSourceFolders = "Delivered&Read,File server,ICT,Ram,Scs,Sophos,External Senders"
would be a problem ... like I said:

    strSourceFolders = "Sop1, Sop2, Sop 12, Sop3, SOp4, Sop5, Sop6"
DOES NOT need changing it saved declaring seven similarly named subfolders for the source folders.

Chris
0
 
LVL 11

Author Comment

by:bsharath
ID: 26391152
I did the change and when run macro directly i get
Object could not be found

When debug goes here
        Set ProcessFolder = strRootFolder.Folders(strProcessFolder)

These 2 lines hsould it be from and to?

  Set strRootFolder = Application.Session.Folders("All Mails").Folders("inbox")
    #Else
        Set strRootFolder = Application.Session.Folders("Mailbox - Sharath").Folders("inbox")
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 26391202

From only one works for me and one for you
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 26391339
Back on the PC so I can try and explain better:

The code block:

    #If cbPC Then
        Set strRootFolder = Application.Session.Folders("All Mails").Folders("inbox")
    #Else
        Set strRootFolder = Application.Session.Folders("Mailbox -Sharath").Folders("inbox")
    #End If

Is the same as:
        Set strRootFolder = Application.Session.Folders("Mailbox -Sharath").Folders("inbox")
on your pc whereas it is the same as:
        Set strRootFolder = Application.Session.Folders("All Mails").Folders("inbox")
on mine.

In this way I can test on my PC and it is less likely I forget to make the correction when posting.  i.e. simply ignore the complexity as it is to all intents simply a single line that defines the root of the from folder and off which the sub folders in the strSourceFolders are defined.

As for the rep[orted error are you sure of folders in the string "Sop1, Sop2, Sop 12, Sop3, SOp4, Sop5, Sop6" already exist as subfolders off Mailbox -Sharath\Inbox.  Because it seems to be saying noting is found ...

i.e. what do you have now for the equivalent lines 23:25 in my earlier post?

Chris
0
 
LVL 11

Author Comment

by:bsharath
ID: 26391795
This is the destination paths

Const strSop1Moveto As String = "\\All Mails\Inbox\Delivered&Read"
Const strSop2Moveto As String = "\\All Mails\Inbox\File server"
Const strSop12Moveto As String = "\\All Mails\Inbox\ICT"
Const strSop3Moveto As String = "\\All Mails\Inbox\Ram"
Const strSop4Moveto As String = "\\All Mails\Inbox\Scs"
Const strSop5Moveto As String = "\\All Mails\Inbox\Sophos"
Const strSop6Moveto As String = "\\All Mails\Inbox\External senders"

or should it be the source paths


I havr the below lines

 Set strRootFolder = Application.Session.Folders("Mailbox - Sharath").Folders("inbox")
    #Else
        Set strRootFolder = Application.Session.Folders("All Mails").Folders("inbox")
    #End If
    strSourceFolders = "Sop1, Sop2, Sop 12, Sop3, Sop4, Sop5, Sop6"

0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 26391867
So far so good.

When it stops what value does strProcessFolder have .. a rollover of the cursor should tell you.

Chris
0
 
LVL 11

Author Comment

by:bsharath
ID: 26391916
I get process folder = nothing
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 26392055
Can you upload the code as you are using it as something is wrong and it's either the code (I can check if something is significantly messed up in the edits) or the source folder(s) do not exist.

Chris
0
 
LVL 11

Author Comment

by:bsharath
ID: 26392064
Belo is the full code....
Sub Q25048313()
Dim RootFolder As Object
Dim ProcessFolder As Object
Dim DestFolder As Object
Dim strRootFolder As Object
Dim strSourceFolders As String
Dim strProcessFolder As Variant
Dim itm As Object
Dim itmCount As Integer
Const strSop1Moveto As String = "\\All Mails\Inbox\Delivered&Read"
Const strSop2Moveto As String = "\\All Mails\Inbox\File server"
Const strSop12Moveto As String = "\\All Mails\Inbox\ICT"
Const strSop3Moveto As String = "\\All Mails\Inbox\Ram"
Const strSop4Moveto As String = "\\All Mails\Inbox\Scs"
Const strSop5Moveto As String = "\\All Mails\Inbox\Sophos"
Const strSop6Moveto As String = "\\All Mails\Inbox\External senders"
     
    #If cbPC Then
        Set strRootFolder = Application.Session.Folders("Mailbox - Sharath").Folders("inbox")
    #Else
        Set strRootFolder = Application.Session.Folders("All Mails").Folders("inbox")
    #End If
    strSourceFolders = "Sop1, Sop2, Sop 12, Sop3, Sop4, Sop5, Sop6"
    For Each strProcessFolder In Split(Replace(strSourceFolders, ", ", ","), ",")
        Set ProcessFolder = strRootFolder.Folders(strProcessFolder)
        Select Case LCase(strProcessFolder)
            Case "sop1"
                Set DestFolder = olkNav2Folder(strSop1Moveto, True)
            Case "sop2"
                Set DestFolder = olkNav2Folder(strSop2Moveto, True)
            Case "sop 12"
                Set DestFolder = olkNav2Folder(strSop12Moveto, True)
            Case "sop3"
                Set DestFolder = olkNav2Folder(strSop3Moveto, True)
            Case "sop4"
                Set DestFolder = olkNav2Folder(strSop4Moveto, True)
            Case "sop5"
                Set DestFolder = olkNav2Folder(strSop5Moveto, True)
            Case "sop6"
                Set DestFolder = olkNav2Folder(strSop6Moveto, True)
            Case Else
                MsgBox "Unexpected Folder detected"
        End Select
        For itmCount = ProcessFolder.Items.Count To 1 Step -1
            ProcessFolder.Items(itmCount).Move DestFolder
        Next
    Next
     
End Sub
 
Public Function olkNav2Folder(foldername As String, Optional createFolders As Boolean) As Object
Dim olApp As Object
Dim olNS As Object
Dim olfldr As Object
Dim reqdFolder As Object
Dim arrFolders() As String
Dim nestCount As Integer
 
    On Error Resume Next
    foldername = Replace(Replace(foldername, "/", "\"), "\\", "")
    If Right(foldername, 1) = "\" Then foldername = Left(foldername, Len(foldername) - 1)
    arrFolders() = Split(foldername, "\")
    Set olApp = CreateObject("Outlook.Application")
    Set olNS = olApp.GetNamespace("MAPI")
    Set reqdFolder = olNS.Folders.Item(arrFolders(0))
    For nestCount = 1 To UBound(arrFolders)
        If Not reqdFolder Is Nothing Then
            Set olfldr = reqdFolder.Folders
            Set reqdFolder = olfldr.Item(arrFolders(nestCount))
            If reqdFolder <> olfldr.Item(arrFolders(nestCount)) Then
                If createFolders Then
                    reqdFolder.Folders.Add (arrFolders(nestCount))
                    Set olfldr = reqdFolder.Folders
                    Set reqdFolder = olfldr.Item(arrFolders(nestCount))
                Else
                    Set reqdFolder = Nothing
                    Exit For
                End If
            End If
        Else
        End If
    Next
    Set olkNav2Folder = reqdFolder
    Set olApp = Nothing
    Set olNS = Nothing
    Set olfldr = Nothing
    Set reqdFolder = Nothing
End Function

Open in new window

0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 26392092
I missed the change you hade to the #if construct assuming it was still as per the original post.  I have taken my original post and applied the changes from yours for ther destination folders.  Hopefully that will work without any other edit.

Chris
Sub Q25048313() 
Dim RootFolder As Object 
Dim ProcessFolder As Object 
Dim DestFolder As Object 
Dim strRootFolder As Object 
Dim strSourceFolders As String 
Dim strProcessFolder As Variant 
Dim itm As Object 
Dim itmCount As Integer 
Const strSop1Moveto As String = "\\All Mails\Inbox\Delivered&Read" 
Const strSop2Moveto As String = "\\All Mails\Inbox\File server" 
Const strSop12Moveto As String = "\\All Mails\Inbox\ICT" 
Const strSop3Moveto As String = "\\All Mails\Inbox\Ram" 
Const strSop4Moveto As String = "\\All Mails\Inbox\Scs" 
Const strSop5Moveto As String = "\\All Mails\Inbox\Sophos" 
Const strSop6Moveto As String = "\\All Mails\Inbox\External senders" 
     
    #If cbPC Then 
        Set strRootFolder = Application.Session.folders("Personal Folders").folders("inbox") 
    #Else 
        Set strRootFolder = Application.Session.folders("Mailbox -Sharath").folders("inbox") 
    #End If 
    strSourceFolders = "Sop1, Sop2, Sop 12, Sop3, SOp4, Sop5, Sop6" 
    For Each strProcessFolder In Split(Replace(strSourceFolders, ", ", ","), ",") 
        Set ProcessFolder = strRootFolder.folders(strProcessFolder) 
        Select Case LCase(strProcessFolder) 
            Case "sop1" 
                Set DestFolder = olkNav2Folder(strSop1Moveto, True) 
            Case "sop2" 
                Set DestFolder = olkNav2Folder(strSop2Moveto, True) 
            Case "sop 12" 
                Set DestFolder = olkNav2Folder(strSop12Moveto, True) 
            Case "sop3" 
                Set DestFolder = olkNav2Folder(strSop3Moveto, True) 
            Case "sop4" 
                Set DestFolder = olkNav2Folder(strSop4Moveto, True) 
            Case "sop5" 
                Set DestFolder = olkNav2Folder(strSop5Moveto, True) 
            Case "sop6" 
                Set DestFolder = olkNav2Folder(strSop6Moveto, True) 
            Case Else 
                MsgBox "Unexpected Folder detected" 
        End Select 
        For itmCount = ProcessFolder.items.count To 1 Step -1 
            ProcessFolder.items(itmCount).Move DestFolder 
        Next 
    Next 
     
End Sub 
 
Public Function olkNav2Folder(foldername As String, Optional createFolders As Boolean) As Object 
Dim olApp As Object 
Dim olNS As Object 
Dim olfldr As Object 
Dim reqdFolder As Object 
Dim arrFolders() As String 
Dim nestCount As Integer 
 
    On Error Resume Next 
    foldername = Replace(Replace(foldername, "/", "\"), "\\", "") 
    If Right(foldername, 1) = "\" Then foldername = Left(foldername, Len(foldername) - 1) 
    arrFolders() = Split(foldername, "\") 
    Set olApp = CreateObject("Outlook.Application") 
    Set olNS = olApp.GetNamespace("MAPI") 
    Set reqdFolder = olNS.folders.Item(arrFolders(0)) 
    For nestCount = 1 To UBound(arrFolders) 
        If Not reqdFolder Is Nothing Then 
            Set olfldr = reqdFolder.folders 
            Set reqdFolder = olfldr.Item(arrFolders(nestCount)) 
            If reqdFolder <> olfldr.Item(arrFolders(nestCount)) Then 
                If createFolders Then 
                    reqdFolder.folders.Add (arrFolders(nestCount)) 
                    Set olfldr = reqdFolder.folders 
                    Set reqdFolder = olfldr.Item(arrFolders(nestCount)) 
                Else 
                    Set reqdFolder = Nothing 
                    Exit For 
                End If 
            End If 
        Else 
        End If 
    Next 
    Set olkNav2Folder = reqdFolder 
    Set olApp = Nothing 
    Set olNS = Nothing 
    Set olfldr = Nothing 
    Set reqdFolder = Nothing 
End Function

Open in new window

0
 
LVL 11

Author Comment

by:bsharath
ID: 26392320
Chris still get the same message
But now when mouse over i get
strProcessFolder
> strProcessFolder= "sop1"
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 26392398
Okay then either the root folder does not exist or the sop1 one.  Put the cursor in the outlook explorer onto the sop1 folder then in the VBE type:

?">>>" & application.ActiveExplorer.CurrentFolder.FolderPath & "<<<"

WHat do you get?

Chris
0
 
LVL 11

Author Comment

by:bsharath
ID: 26392443
I Get this

?">>>" & application.ActiveExplorer.CurrentFolder.FolderPath & "<<<"
>>>\\Mailbox - Sharath\Inbox\Delivered&Read<<<
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 26392513
The sop1 folder is called "Delivered&Read"!!!!
In the original question you stated:
I have these folders in this path
Mailbox -Sharath\Inbox\Sop1
...
Mailbox -Sharath\Inbox\Sop6

I appreciate that is what you changed the strSourceFolders to say but it contradicts the original post so I thought you were referring to the destination folders when you edited it.  Since the situation is confused can you please identify a list of the folders to be processed and the folder to which each 'source' folder must move?

Chris
0
 
LVL 11

Author Comment

by:bsharath
ID: 26392563
Ok

I have the Mails here

\\Mailbox - Sharath\Inbox\Delivered&Read
\\Mailbox - Sharath\Inbox\File server
\\Mailbox - Sharath\Inbox\ICT
\\Mailbox - Sharath\Inbox\Ram
\\Mailbox - Sharath\Inbox\SCS
\\Mailbox - Sharath\Inbox\External senders

Need the folder mails to be moved to the below paths
"\\All Mails\Inbox\Delivered&Read"
"\\All Mails\Inbox\File server"
"\\All Mails\Inbox\ICT"
"\\All Mails\Inbox\Ram"
"\\All Mails\Inbox\Scs"
"\\All Mails\Inbox\Sophos"
"\\All Mails\Inbox\External senders"


Please change the lines

0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 26392599
How about the sophos source folder ... is that:

\\Mailbox - Sharath\Inbox\Sophos

Chris
0
 
LVL 11

Author Comment

by:bsharath
ID: 26392628
Sorry missed that here
But i have it on the code...

B ut i will have many more folders in the real paths which need to be skipped and move just 7 to 7
\Mailbox - Sharath\Inbox\Dead mails
\Mailbox - Sharath\Inbox\Alive mails
0
 
LVL 59

Accepted Solution

by:
Chris Bottomley earned 2000 total points
ID: 26392868
Sharath

If I understand the situation correctly now then:

Chris
Sub Q25048313()
Dim RootFolder As Object
Dim ProcessFolder As Object
Dim DestFolder As Object
Dim strRootFolder As Object
Dim strDestRoot As Object
Dim strSourceFolders As String
Dim strProcessFolder As Variant
Dim itm As Object
Dim itmCount As Integer
Dim strFolderArray() As String
    
    #If cbPC Then
        Set strRootFolder = Application.Session.folders("Personal Folders").folders("inbox")
        Set strDestRoot = Application.Session.folders("Personal Folders").folders("testmoves")
        strSourceFolders = "Sop1, Sop2, Sop 12, Sop3, SOp4, Sop5, Sop6"
    #Else
        Set strRootFolder = Application.Session.folders("Mailbox -Sharath").folders("inbox")
        Set strDestRoot = Application.Session.folders("Mailbox -Sharath").folders("all mails")
        strSourceFolders = "Delivered&Read,File server,ICT,Ram,Scs,Sophos,External Senders"
    #End If
    strFolderArray = Split(Replace(strSourceFolders, ", ", ","), ",")
    For Each strProcessFolder In strFolderArray
        Set ProcessFolder = strRootFolder.folders(strProcessFolder)
        Set DestFolder = strDestRoot.folders(strProcessFolder)
        For itmCount = ProcessFolder.items.count To 1 Step -1
            ProcessFolder.items(itmCount).Move DestFolder
        Next
    Next
    
End Sub

Open in new window

0
 
LVL 11

Author Comment

by:bsharath
ID: 26395109
Thanks...
Works perfect....
0

Featured Post

Independent Software Vendors: 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

Finding original email is quite difficult due to their duplicates. From this article, you will come to know why multiple duplicates of same emails appear and how to delete duplicate emails from Outlook securely and instantly while vital emails remai…
Changing a few Outlook Options can help keep you organized!
Many of my clients call in with monstrous Gmail overloading issues with Outlook. A quick tip is to turn off the All Mail and Important folders from synching. Here is a quick video I made to show you how to turn off these and other folders in Gmail s…
A short tutorial showing how to set up an email signature in Outlook on the Web (previously known as OWA). For free email signatures designs, visit https://www.mail-signatures.com/articles/signature-templates/?sts=6651 If you want to manage em…
Suggested Courses

800 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