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

Question

I seem to be getting issues with moving emails from inbox to a sub-folder of inbox. I always thought my code was working until today. I noticed it's only moving half of the emails. I do not need a "move all" code, I have a purpose for this but I just need to move each emails and not all at once (I needed to check each emails). Please take a look at my code below. myNamespace.Folders.Item(1).Folders.Item(2) is my main Inbox.

Sub MoveEachInboxItems()
    Dim myNamespace As Outlook.NameSpace
    Set myNamespace = Application.GetNamespace("MAPI")

    For Each Item In myNamespace.Folders.Item(1).Folders.Item(2).Items
        Dim oMail As Outlook.MailItem: Set oMail = Item
           Item.UnRead = True
           Item.move myNamespace.Folders.Item(1).Folders.Item(2).Folders("Other Emails")
    Next
End Sub

Answer 1

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