?
Solved

Need to find duplicate folders and move mails accordingly

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

Need to find duplicate folders and move mails accordingly

Say i have 2 identical folders within a root folder like

Sharath
Sharath1

1 will be the increment for the identical folder.

If found 1 at the end of the folder name then check for similar folder name without one. if found move all mails from the 1 named folder to the identical named folder and then delete the empty folder.

Regards
Sharath
0
Comment
Question by:bsharath
  • 6
  • 5
12 Comments
 
LVL 76

Expert Comment

by:David Lee
ID: 26213171
Hi, Sharath.

Search where?  All folders in all mailboxes and PST files?  Also are you saying that the name match is only to occur if the second folder has a 1 on the end?  For example, Sharath and Sharath1 would be considered a match but Sharath and Sharath2 would not.  Is that correct?
0
 
LVL 11

Author Comment

by:bsharath
ID: 26213361
Search just the subfolders that i select the root folder and run..
just the folders below the selected folder
Full exact name has to be matched and 1 alone. I havent seen any with 2 till now. So we shall take 1 into consideration and move mails from Sharath1 to Sharath and delete Sharath1
Find duplicates for all name matches. Folder names will have spaces....
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 26281147
bsharath:

Does this requirement apply only to those folders directly below the selected folder ...

fred
    doris
    doris1
    norman
        doris

i.e. if Fred is the root folder selected then the function applies to:
fred\doris
fred\doris1
fred\norman

AND NOT

fred\norman\doris

Chris
0
Restore individual SQL databases with ease

Veeam Explorer for Microsoft SQL Server delivers an easy-to-use, wizard-driven interface for restoring your databases from a backup. No expert SQL background required. Web interface provides a complete view of all available SQL databases to simplify the recovery of lost database

 
LVL 11

Author Comment

by:bsharath
ID: 26281155
It applies to just the Root folder

fred
    doris
    doris1
    norman
        doris
Only where no 1 shows as duplicate
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 26281168
fred
    doris
    doris1
    norman
        doris1

Sorry still not clear, is folder fred\norman\doris1 in the above scenario excluded

Chris
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 26281333
Assuming it is just the immediate sub folders then:

Chris
Sub Q25029903()
Dim myFolder As MAPIFolder
Dim itm As Object
Dim fldr As Object
Dim intFldr As Integer
        
    Set myFolder = Application.GetNamespace("mapi").PickFolder
    If Not myFolder Is Nothing Then
        For intFldr = myFolder.folders.count To 1 Step -1
            Set fldr = myFolder.folders(intFldr)
            If IsNumeric(Right(fldr.Name, 1)) Then
                If Not myFolder.folders(Left(fldr.Name, Len(fldr.Name) - 1)) Is Nothing Then
                    For Each itm In fldr.items
                        itm.Move myFolder.folders(Left(fldr.Name, Len(fldr.Name) - 1))
                    Next
                    fldr.Delete
                End If
            End If
        Next
    End If

End Sub

Open in new window

0
 
LVL 11

Author Comment

by:bsharath
ID: 26281442
Chris its the immediate Sub folder.
Will it Copy emails and delete the duplicate folder also?
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 26281477
The script above processes the folders immediately below the selected folder and moves all the items in a numbered suffix to the folder of the same name without a suffix and then deletes the suffixed folder.

IF there is no folder without the suffix then it does nothing.

Chris
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 26282604
Stupid mistake therein!  Please see correction

Chris
Sub Q25029903() 
Dim myFolder As MAPIFolder 
Dim intItem As integer 
Dim itm As Object 
Dim fldr As Object 
Dim intFldr As Integer 
         
    Set myFolder = Application.GetNamespace("mapi").PickFolder 
    If Not myFolder Is Nothing Then 
        For intFldr = myFolder.folders.count To 1 Step -1 
            Set fldr = myFolder.folders(intFldr) 
            If IsNumeric(Right(fldr.Name, 1)) Then 
                If Not myFolder.folders(Left(fldr.Name, Len(fldr.Name) - 1)) Is Nothing Then 
                    For intItem = fldr.items.count to 1 step -1
                        set itm = fldr.items(intItem)
                        itm.Move myFolder.folders(Left(fldr.Name, Len(fldr.Name) - 1)) 
                    Next 
                    fldr.Delete 
                End If 
            End If 
        Next 
    End If 
 
End Sub

Open in new window

0
 
LVL 11

Author Comment

by:bsharath
ID: 26285055
Chris i get this

An Object failed could not be found

WHEN DEBUG GOES HERE'
                If Not myFolder.Folders(Left(fldr.Name, Len(fldr.Name) - 1)) Is Nothing Then
0
 
LVL 59

Accepted Solution

by:
Chris Bottomley earned 2000 total points
ID: 26285672
Think i've found that one but i'm using a function to change the method so see if you have the olkNav2Folder function somewhere and if not try Nav2Folder.

Chris
Sub Q25029903()
Dim myFolder As MAPIFolder
Dim intItem As Integer
Dim itm As Object
Dim fldr As Object
Dim intFldr As Integer
          
    Set myFolder = Application.GetNamespace("mapi").PickFolder
    If Not myFolder Is Nothing Then
        For intFldr = myFolder.folders.count To 1 Step -1
            Set fldr = myFolder.folders(intFldr)
            If IsNumeric(Right(fldr.Name, 1)) Then
                If Not olkNav2Folder(myFolder.folderpath & "\" & Left(fldr.Name, Len(fldr.Name) - 1)) Is Nothing Then
                    For intItem = fldr.items.count To 1 Step -1
                        Set itm = fldr.items(intItem)
                        itm.Move myFolder.folders(Left(fldr.Name, Len(fldr.Name) - 1))
                    Next
                    fldr.Delete
                End If
            End If
        Next
    End If
  
End Sub

Open in new window

0
 
LVL 11

Author Comment

by:bsharath
ID: 26285742
0

Featured Post

Microsoft Certification Exam 74-409

Veeam® is happy to provide the Microsoft community with a study guide prepared by MVP and MCT, Orin Thomas. This guide will take you through each of the exam objectives, helping you to prepare for and pass the examination.

Question has a verified solution.

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

Microsoft Office Picture Manager was included in Office 2003, 2007, and 2010, but not in Office 2013. Users had hopes that it would be in Office 2016/Office 365, but it is not. Fortunately, the same zero-cost technique that works to install it with …
With so many activities to perform, Exchange administrators are always busy in organizations. If everything, including Exchange Servers, Outlook clients, and Office 365 accounts work without any issues, they can sit and relax. But unfortunately, it…
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…
This is my first video review of Microsoft Bookings, I will be doing a part two with a bit more information, but wanted to get this out to you folks.
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