Move a specific number of emails from shared Outlook folder

Question

Every few days I manually move a specified number of emails from a shared network mailbox to subfolders of team managers. They want them moved from oldest to newest. Both the managers and the number can change each time.

I wrote a script for moving a small number of emails with a specific subject line in the folder to a subfolder to be worked by a certain group.

I have tried to adapt this to my current task.

Sub Moverdaily()

    On Error GoTo errHandler

    Dim olApp As Outlook.Application
    Dim objNS As Outlook.Namespace
    Dim olFolder As Outlook.MAPIFolder
    Dim msg As Outlook.MailItem
    Dim manager= As Outlook.MAPIFolder
    Dim cell,start,finish,rng   As Range
    Dim countE,countM  As Integer
    Dim emcount, casecount, movedcount
    Set rng = Range(Range("A2"), Range("A2").End(xlDown))
    Set olApp = Outlook.Application
    Set objNS = olApp.GetNamespace("MAPI")
    Set olFolder = objNS.Folders("Documents").Folders("Inbox")
    Set manager = objNS.Folders("Document").Folders("Inbox").Folders("Manager")
    Set finish = ThisWorkbook.Sheets("Mover").Range("I11")
    Set start = ThisWorkbook.Sheets("Mover").Range("I10")
    start.Value = Format(Now, "hh:mm:ss")
    Set emcount = Range("I12")
    Set casecount = Range("I13")
    Set movedcount = Range("I14")

    countM = 0
    countE = 0

    For i = olFolder.Items.count To 1 Step -1  
        For Each cell In rng
            If (cell.Text = (onlyDigits(msg.Subject))) Then
                msg.move manager 
                countM = 1 + countM
                cell.Offset(0, 1).Value = "Moved"
            End If
        Next
        countE = 1 + countE
    Next

    finish.Value = Format(Now, "hh:mm:ss")
    emcount.Value = countE
    casecount.Value = rng.count
    movedcount.Value = countM

errHandler:
    MsgBox ("Error " & Err.Number & ": " & Err.Description)
    Exit Sub

End Sub

Answer 1

Firstly, do not use "for each" with a collection that you change - MailItem.Mpve removes an itemn from that collection. Use a for i = Items.Count to 1 step -1 instead.

Secondly, do not loop through all item - if you already know the entry ids (rngarry), simply call Namespace.GetItemfromID .