Outlook Macro to search the Inbox alone and if the sender has more than 20 mails sent to me has to create a folder and move the mails to the folder

script can be used to create folders in inbox and the rules can be used to move to folders

Can you create rules and folders?

try this script for creating folders. This is a vbscript

Set objOutlook = CreateObject("Outlook.Application")
Set myNameSpace = objOutlook.GetNamespace("MAPI")
Set myInboxFolder = myNameSpace.GetDefaultFolder(6)
Set myNewFolder = myInboxFolder.Folders.Add("Myfolder")

regards
Chandru

Should i put this in the outlook Module.?Or use it as a vbs.
What will this script do?

it is a vbs script

What will the script do?

Create a folder in Outlook inbox

But how can this help me in what i want.
I have a script that can create folders as per the txt file.I have the names in the txt file.But what about the movement

I have most of the pieces to do what you are asking figured out ... I now need to try and collate them.  Hopefully I will have a response in a week or so ... unless you get a satisfactory solution in the meantime.

Chris

Thanks Chris...

Please try the following:  I have applied a reasonable degree of testing so I believe it works ok:

Chris

Sub moveExcessEmails()
 
Dim olApp As Outlook.Application
Dim objNS As Outlook.NameSpace
Dim MyFolder As Outlook.MAPIFolder
Dim targetFolder As Outlook.MAPIFolder
Dim olMailItems As Outlook.Items
Dim mailCount As Integer
Dim mailCounter As Integer
Dim mai As Outlook.mailitem
Dim strFilter As String
    On Error Resume Next
    
    Set olApp = Outlook.Application
    Set objNS = olApp.GetNamespace("MAPI")
    Set MyFolder = objNS.GetDefaultFolder(olFolderInbox)
    For Each mai In MyFolder.Items
        strFilter = "[SenderEmailAddress] = " & append_quotes(mai.SenderEmailAddress)
        Set olMailItems = objNS.GetDefaultFolder(olFolderInbox).Items.Restrict(strFilter)
        mailCount = olMailItems.Count
        If mailCount >= 20 Then
            Set targetFolder = findFolder(olMailItems.Item(1).SenderName)
            Debug.Print olMailItems.Item(1).SenderName & ", (" & mailCount & " items)."
            For mailCounter = mailCount To 1 Step -1
                olMailItems.Item(mailCounter).Move targetFolder
            Next
'            Stop
        End If
    Next
    
Set olMailItems = Nothing
Set objNS = Nothing
Set olApp = Nothing
Set MyFolder = Nothing
 
End Sub
Function append_quotes(objString As String) As String
    append_quotes = Chr(34) & CStr(objString) & Chr(34)
End Function
Function findFolder(sender As String) As Outlook.MAPIFolder
Dim str_folder As String
Dim ol_app As Outlook.Application
Dim OL_namespace As Outlook.NameSpace
Dim OL_Folders As Outlook.Folders
Dim Required_Folder As Outlook.MAPIFolder
Dim arr_folders() As String
Dim nest_count As Integer
 
    str_folder = "personal folders/inbox/" & sender
    
    On Error Resume Next
    str_folder = Replace(str_folder, "/", "\")
    If Right(str_folder, 1) = "\" Then str_folder = Left(str_folder, Len(str_folder) - 1)
    arr_folders() = Split(str_folder, "\")
    Set ol_app = CreateObject("outlook.application")
    Set OL_namespace = ol_app.GetNamespace("MAPI")
    Set Required_Folder = OL_namespace.Folders.Item(arr_folders(0))
    If Not Required_Folder Is Nothing Then
        For nest_count = 1 To UBound(arr_folders)
            Set OL_Folders = Required_Folder.Folders
            Set Required_Folder = Nothing
            Set Required_Folder = OL_Folders.Item(arr_folders(nest_count))
            If Required_Folder Is Nothing Then Set Required_Folder = OL_Folders.Add(arr_folders(nest_count))
        Next
    End If
    Set findFolder = Required_Folder
    Set ol_app = Nothing
    Set OL_namespace = Nothing
    Set OL_Folders = Nothing
    Set Required_Folder = Nothing
End Function

Select allOpen in new window

wasnt as difficult as I feared to join them up ... before testing wouldnt be a bad idea to copy the pst file just in case!

Chris

SPoke too soon ... I am seeing an issue!  BRB

Chris

Cris i just check but nothing happens.
I have the mails in the pst Personal folder not the mail box store.
So is there anything i need to change.

Rank amateur or what ...

I failed to delete one of the test lines in the findfolder function, (I used a common folder to make it easier to re-instate the inbox for additional tests.  simply delete or comment out the following line:

    str_folder = "personal folders/inbox/" & "movefolder"

if you have already run the macro then select everything in the inbox/movefolder and drag them back to the inbox after disabling the erroneous line.

Chris

Excellent Chris..

You have designed it so well without errors after a test i ran it on my live pst which had 39,000 mails and all the job was done in just 5 min
Thanks a lot for the help....

BSHARATH

Glad to help ... I enjoy new tasks and to achieve this involved figuring out some new techniques so it was genuinely a request I enjoyed working on.

Chris

Chris & Chandru here is another Genuine post.See if you can help...
https://www.experts-exchange.com/questions/22997550/Outlook-Macro-to-move-all-Follow-up-checked-mails-to-a-folder-specified.html

Chris. how are u.
Just one question on this post. Is there a way that i run the macro on any folder other than inbox and it creates folders below that like sub folders who have more than 20 mails...
if yes i shall post a new Q... This is like very useful for me please..