I have this code that retrieves emails in a subfolder in Outlook and creates a report with the sender name, subject, and creation time. Prior to populating this information in columns A:D, I would like it to first sort through the emails via a user input for a start date and end date and if the email is within the date range then populate the information in columns A:D. How would I do this? To preface, this code works great to extract all emails in the subfolder “CZI” but this inbox receives many emails daily and I do not want it to sort through each email as this would slow down the process. I just need it to provide emails within a user-specified date range.

Sub GetEmail ()

Dim olApp As Outlook.Application
Dim objNS As Outlook.Namespace
Dim olFolder As Outlook.MAPIFolder
Dim subfolder As Object
Dim MyItems As Variant
Dim msg As Outlook.MailItem
Dim f As Long, n As Long, NumItems As Long
'
Application.ScreenUpdating = False
Set olApp = Outlook.Application
Set objNS = olApp.GetNamespace("MAPI")
'
Set olFolder = objNS.Folders("[email protected]")
Set subfolder = olFolder.Folders("Inbox").Folders("CZI")
Set MyItems = subfolder.Items

Columns("A:D").Clear
NumItems = subfolder.Items.Count
f = 1
On Error Resume Next
For n = 1 To NumItems
    Cells(f, "A") = MyItems(n).SenderName
    Cells(f, "B") = MyItems(n).Subject
    Cells(f, "C") = MyItems(n).Body
    Cells(f, "D") = MyItems(n).CreationTime
    f = f + 1

Next
Columns("B:C").WrapText = False
Application.ScreenUpdating = True

End Sub

End Sub

I tried adding a piece of code (in bold) but I keep getting a run-time error “424”. Any advice? Thank you!

Sub GetEmail()

    Dim olApp As Outlook.Application
    Dim objNS As Outlook.Namespace
    Dim olFolder As Outlook.MAPIFolder
    Dim subfolder As Object
    Dim MyItems As Variant
    Dim msg As Outlook.MailItem
    Dim f As Long, n As Long, NumItems As Long
    '
    Application.ScreenUpdating = False
    Set olApp = Outlook.Application
    Set objNS = olApp.GetNamespace("MAPI")
    '
    Set olFolder = objNS.Folders("[email protected]")
    Set subfolder = olFolder.Folders("Inbox").Folders("CZI")
    Set MyItems = subfolder.Items

**rngA = Application.InputBox(prompt := "Start Date", type := 8)
rngB = Application.InputBox(prompt := "End Date", type := 8)

    Dim StartDate As Date, EndDate As Date

'~~> rngA and rngB are relevant ranges
StartDate = DateValue(rngA.Value2)
EndDate = DateValue(rngB.Value2)

For Each MyItems In subfolder
    If MyItems.Class = olMail Then
        If MyItems.SentOn >= StartDate And MyItems.SentOn <= EndDate Then
            '~~> Rest of your code

            i = i + 1
        End If
    ElseIf MyItems.Class = olReport Then
        '~~> Rest of your code

         i = i + 1
    End If
Next MyItems**
    

    Columns("A:D").Clear
    NumItems = subfolder.Items.Count
    f = 1
    On Error Resume Next
    For n = 1 To NumItems
        Cells(f, "A") = MyItems(n).SenderName
        Cells(f, "B") = MyItems(n).Subject
        Cells(f, "C") = MyItems(n).Body
        Cells(f, "D") = MyItems(n).CreationTime
        f = f + 1

    Next
    Columns("B:C").WrapText = False
    Application.ScreenUpdating = True


End Sub