Sub MailSave()
    Dim oOutlook As New Outlook.Application
    Dim oNamespace As Outlook.Namespace
    Dim oFolder As Outlook.MAPIFolder
    Dim oItem As Outlook.Items
    Dim oMailItem As Outlook.MailItem
    Dim oStartDates1 As Date
    Dim oStartDates2 As Date
    Dim r
  
        Set oNamespace = oOutlook.GetNamespace("MAPI")
        
         Set oFolder = oNamespace.PickFolder
        Set oItem = oFolder.Items
        
        
        oStartDates1 = InputBox("Type the start date (format DD/MM/YYYY)")

        oStartDates2 = InputBox("Type the start date (format DD/MM/YYYY)")
        
        
         
        Cells.Clear
        Cells(1, 1) = "SenderName"
        Cells(1, 2) = "SenderEmailAddress"
        Cells(1, 3) = "To"
        Cells(1, 4) = "Subject"
        Cells(1, 5) = "ReceivedTime"
        Cells(1, 6) = "Categories"
    
  
        r = 2
        For Each oMailItem In oItem

          If oMailItem.CreationTime >= oStartDates1 And oMailItem.CreationTime <= oStartDates2 Then

            On Error Resume Next
                Cells(r, 1) = oMailItem.SenderName
                Cells(r, 2) = oMailItem.SenderEmailAddress
                Cells(r, 3) = oMailItem.To
                Cells(r, 4) = oMailItem.Subject
                Cells(r, 5) = oMailItem.CreationTime
                Cells(r, 6) = oMailItem.Categories
                
                 On Error GoTo 0
                    r = r + 1
         
       End If
        Next
  
      
End Sub