How to move each emails from inbox to a sub-folder [duplicate]

by

here is good link

Moves Outlook Mail items to a Sub folder by Email address

Option Explicit
Public Sub Move_Items()
'   // Declare your Variables
    Dim Inbox As Outlook.MAPIFolder
    Dim SubFolder As Outlook.MAPIFolder
    Dim olNs As Outlook.NameSpace
    Dim Item As Object
    Dim Items As Outlook.Items
    Dim lngCount As Long

    On Error GoTo MsgErr
'    Set Inbox Reference
    Set olNs = Application.GetNamespace("MAPI")
    Set Inbox = olNs.GetDefaultFolder(olFolderInbox)
    Set Items = Inbox.Items

'   // Loop through the Items in the folder backwards
    For lngCount = Items.Count To 1 Step -1
        Set Item = Items(lngCount)

        If Item.Class = olMail Then
            Select Case Item.SenderEmailAddress

'               // Email_One
                Case "[email protected]"
'                   // Set SubFolder of Inbox
                    Set SubFolder = Inbox.Folders("Folder One")
                    Set Item = Items.Find("[SenderEmailAddress] = '[email protected]'")
                    If TypeName(Item) <> "Nothing" Then
'                       // Mark As Read
                        Item.UnRead = False
'                       // Move Mail Item to sub Folder
                        Item.Move SubFolder
                    End If

'               // Email_Two
                Case "[email protected]"
'                   // Set SubFolder of Inbox
                    Set SubFolder = Inbox.Folders("Folder Two")
                    Set Item = Items.Find("[SenderEmailAddress] = '[email protected]'")
                    If TypeName(Item) <> "Nothing" Then
'                       // Mark As Read
                        Item.UnRead = False
'                       // Move Mail Item to sub Folder
                        Item.Move SubFolder
                    End If

            End Select
        End If
    Next lngCount

MsgErr_Exit:
    Set Inbox = Nothing
    Set SubFolder = Nothing
    Set olNs = Nothing
    Set Item = Nothing
    Set Items = Nothing

    Exit Sub

'// Error information
MsgErr:
    MsgBox "An unexpected Error has occurred." _
         & vbCrLf & "Error Number: " & Err.Number _
         & vbCrLf & "Error Description: " & Err.Description _
         , vbCritical, "Error!"
    Resume MsgErr_Exit
End Sub

Or to move all Mail items Inbox to sub folder

Option Explicit
Public Sub Move_Items()
'   // Declare your Variables
    Dim Inbox As Outlook.MAPIFolder
    Dim SubFolder As Outlook.MAPIFolder
    Dim olNs As Outlook.NameSpace
    Dim Item As Object
    Dim lngCount As Long
    Dim Items As Outlook.Items

    On Error GoTo MsgErr
'    Set Inbox Reference
    Set olNs = Application.GetNamespace("MAPI")
    Set Inbox = olNs.GetDefaultFolder(olFolderInbox)
    Set Items = Inbox.Items

'   // Loop through the Items in the folder backwards
    For lngCount = Items.Count To 1 Step -1
        Set Item = Items(lngCount)

        Debug.Print Item.Subject

        If Item.Class = olMail Then
'           // Set SubFolder of Inbox
            Set SubFolder = Inbox.Folders("Temp")
'           // Mark As Read
            Item.UnRead = False
'           // Move Mail Item to sub Folder
            Item.Move SubFolder
        End If
    Next lngCount

MsgErr_Exit:
    Set Inbox = Nothing
    Set SubFolder = Nothing
    Set olNs = Nothing
    Set Item = Nothing

    Exit Sub

'// Error information
MsgErr:
    MsgBox "An unexpected Error has occurred." _
         & vbCrLf & "Error Number: " & Err.Number _
         & vbCrLf & "Error Description: " & Err.Description _
         , vbCritical, "Error!"
    Resume MsgErr_Exit
End Sub

More Related Contents:

  1. Outlook Reply or ReplyAll to an Email
  2. How to insert text into Outlook email editor using VBA
  3. How do you extract email addresses from the ‘To’ field in outlook?
  4. Get reference to additional Inbox
  5. How do I trigger a macro to run after a new mail is received in Outlook?
  6. Outlook VBA – Run a code every half an hour
  7. For Each loop: Some items get skipped when looping through Outlook mailbox to delete items
  8. Can I iterate through all Outlook emails in a folder including sub-folders?
  9. Download attachment from Outlook and Open in Excel
  10. Embed picture in outlook mail body excel vba
  11. Sending mail using Outlook where the Send method fails
  12. How to do late binding in VBA?
  13. Check for the senderEmailAddress
  14. Running VBA from a HYPERLINK()
  15. Add a “CC recipient” to Outlook 2010 VBA
  16. How to send mail when the .Send does not work?
  17. Using visual basic to access subfolder in Inbox?
  18. When is a MailItem not a MailItem? [closed]
  19. Search structured text in Outlook body
  20. Switching the FROM Inbox
  21. How to send email to multiple recipients with addresses stored in Excel?
  22. How to add an embedded image to an HTML message in Outlook 2010
  23. Iterate all email items in a specific Outlook folder
  24. Restrict Outlook Items by Date
  25. VBA Outlook Mail .display, recording when/if sent manually
  26. MS Access VBA: Sending an email through Outlook [closed]
  27. Where does Outlook store the VBA code files?
  28. Working with current open email
  29. Debugging an Outlook 2007 script fired by a rule
  30. Runtime error 287. Sending Emails through Outlook using VBA in Access

Leave a Comment