Code to move to a new folder emails sent or received on a specified day (regardless of year)

[Pendrigh]

In order to compare emails relating to an annual reporting task, I would like to be able to move to a new folder emails sent or received on a particular day (regardless of year - that is, it would move all emails dated 1 Dec 2000, 1 Dec 2001, 1 Dec 2002, and so on). Ideally I'd like the user to be able to enter their chosen date in a dialog box. I've adapted the following code but it only deals with sent items, not received, and there's no dialog box. It's not quite right. Many thanks for your input.

Sub MoveEmail()
Dim olMAPI As Object    'Outlook.Application
Dim moveFolder As Object     'Outlook.MAPIFolder
Dim InItem As Object     'Outlook.MAPIFolder
Dim MItem As Object     'Outlook.MailItem
Dim sentDate As Date
Dim sentDate2 As Date
Dim myDay As Integer
Dim i As Integer
   
Set olMAPI = GetObject("", "Outlook.Application").GetNamespace("MAPI")
Set InItem = olMAPI.Folders("xtendlink (test)").Folders("Inbox")
Set moveFolder = olMAPI.Folders("xtendlink (test)").Folders("Inbox").Folders("old")
Set dltFolder = olMAPI.Folders("xtendlink (test)").Folders("Deleted Items")

i = 0

If InItem.Items.Count = 0 Then

MsgBox InItem.Items.Count

    MsgBox "There are no messages in the Referral Folder.", vbInformation, _
           "Nothing Found"
    Exit Sub
    
End If

Count = InItem.Items.Count
For i = Count To 1 Step -1
    Set MItem = InItem.Items.Item(i)
        mySub = MItem.Subject
    sentDate = Format(MItem.SentOn, "mm/dd")
        If sentDate = "12/01" Then
        MItem.Move moveFolder
    End If
    
Next
Set moveFolder = Nothing
Set dltFolder = Nothing
Set InItem = Nothing
Set MItem = Nothing
End Sub