I’ve written some poor VBA code (I am new to this) to move emails from one folder to another in Outlook based on a set of date ranges. It only partially works–it does the count correctly, but only moves a select few out of the full amount it should be moving. Any guidance is appreciated.

Sub MoveEmails()
    Dim SourceNamespace As Outlook.NameSpace
    Dim SourceFolder As Outlook.MAPIFolder
    Dim TargetNamespace As Outlook.NameSpace
    Dim TargetFolder As Outlook.MAPIFolder
    Dim StartDate As Date
    Dim EndDate As Date
    Dim EmailCount As Long
    Dim Response As VbMsgBoxResult
    
    ' Confirm with the user before proceeding
    Response = MsgBox("This might take a while. Would you like to proceed?", vbYesNo + vbQuestion, "Confirmation")
    If Response = vbNo Then Exit Sub
    
    ' Set reference to the source and target folders
    Set SourceNamespace = Application.GetNamespace("MAPI")
    Set SourceFolder = SourceNamespace.PickFolder ' Select the source folder
    Set TargetNamespace = Application.GetNamespace("MAPI")
    Set TargetFolder = TargetNamespace.PickFolder ' Select the target folder
    
    ' Show the source and target folders to the user
    MsgBox "Source Folder: " & SourceFolder.FolderPath & vbCrLf & "Target Folder: " & TargetFolder.FolderPath, vbInformation, "Folders Selected"
    
    ' Get the date range from the user
    StartDate = InputBox("Enter the start date (dd/mm/yyyy):")
    EndDate = InputBox("Enter the end date (dd/mm/yyyy):")
    
    ' Show the progress form
    frmProgress.Show vbModeless
    
    ' Call the recursive function to move emails and get the count of emails moved
    EmailCount = MoveFolderEmails(SourceFolder, TargetFolder, StartDate, EndDate)
    
    ' Hide the progress form
    Unload frmProgress
    
    ' Show a summary of the number of emails moved to the user
    MsgBox EmailCount & " emails have been moved.", vbInformation, "Operation Completed"
    
    ' Clean up
    Set SourceFolder = Nothing
    Set SourceNamespace = Nothing
    Set TargetFolder = Nothing
    Set TargetNamespace = Nothing
End Sub

and the function

Function MoveFolderEmails(SourceFolder As Outlook.MAPIFolder, TargetFolder As Outlook.MAPIFolder, StartDate As Date, EndDate As Date) As Long
    Dim SourceItems As Outlook.Items
    Dim Item As Object
    Dim Filter As String
    Dim Subfolder As Outlook.MAPIFolder
    Dim TargetSubfolder As Outlook.MAPIFolder
    Dim EmailCount As Long
    
    ' Set the date range for emails to be moved
    Filter = "[ReceivedTime] >= '" & Format(StartDate, "dd/mm/yyyy") & "' And [ReceivedTime] <= '" & Format(EndDate, "dd/mm/yyyy") & "'"
    
    ' Get the collection of items in the source folder that meet the criteria
    Set SourceItems = SourceFolder.Items.Restrict(Filter)
    
     ' Loop through each item in the collection and move it to the target folder
     For Each Item In SourceItems
        
        If TypeOf Item Is MailItem Then
            Item.Move TargetFolder
            
            ' Increment the count of emails moved and update the counter on screen
            
            EmailCount = EmailCount + 1
            frmProgress.lblCount.Caption = "Number of emails moved: " & EmailCount
            
            DoEvents ' Yield to other processes
            
        End If
        
        If TypeOf Item Is MailItem Then DoEvents ' Yield to other processes
       
          
    Next Item
    

    
    ' Loop through each subfolder in the source folder
    For Each Subfolder In SourceFolder.Folders
        On Error Resume Next
        Set TargetSubfolder = TargetFolder.Folders(Subfolder.Name)
        
        If Err.Number <> 0 Then
            Set TargetSubfolder = TargetFolder.Folders.Add(Subfolder.Name)
            Err.Clear
        End If
       
       EmailCount = EmailCount + MoveFolderEmails(Subfolder, TargetSubfolder, StartDate, EndDate)
       
       Set TargetSubfolder = Nothing
       
       On Error GoTo 0
       
    Next Subfolder
    
    MoveFolderEmails = EmailCount
    
End Function

I was expecting that it would move all the emails rather than what seems a random subset. I suspect that the amount needs to be chunked somehow for Outlook to be able to process? I am not sure!