Sort emails into folders by sender's name

A

anariet

Joined
May 19, 2011
Messages
1
Reaction score
0
Cheers all!

I'm new to VBA and I need some help. I'm trying to write a script to automatically sort all emails on my inbox into PST subfolders named by sender's name.

ie:

Sender 1 should go to "Sender 1" subfolder
Sender 2 should go to "Sender 2" subfolder

The catch is: I don't want to create any new subfolders. All emails which doesn't have according subfolders should be ignored and left on the inbox.

ie:

if there isn't already a "Sender 3" subfolder, all emails sent by Sender 3 should be left on the inbox

The code is working for existing subfolders, but when it doesn't find a subfolder, it halts and stops processing the rest of them items.

Can anyone help me out?

Thanks! :thumb:

Code: 
Sub MoverEmails()
   Dim olns As Outlook.NameSpace
   Dim oConItems As Outlook.Items
   Dim iNumItems As Integer
   Dim objTargetFolder As Outlook.MAPIFolder
      
   Set objNS = Application.GetNamespace("MAPI")
   Set oInboxItems = objNS.GetDefaultFolder(olFolderInbox).Items
        
   iNumItems = oInboxItems.Count

   For I = iNumItems To 1 Step -1
      Set objCurItem = oInboxItems.Item(I)
      If TypeName(objCurItem) = "MailItem" Then
            objDestFolder = objCurItem.SenderName
            Set objTargetFolder = Outlook.Application.GetNamespace("MAPI").Folders("PST Trabalho").Folders("Meus Emails").Folders("Teste").Folders(objDestFolder)
            objCurItem.Move objTargetFolder
      End If
   Next

   MsgBox "Movidos " & iNumItems & " items."

   Set objInboxItems = Nothing
   Set objTargetFolder = Nothing
   Set objNS = Nothing

End Sub
 
Back
Top