Count Emails, No display of date when no mails received, Outlook folders to Excel range

Hi,

From code below, I would like to be able to query from a range of chosen date and only showing date with received emails.
Any help would b highly appreciated.

Cheers
dude6571

Sub HowMany_Dated_Emails()
    
    ' Set Variables
    Dim objOutlook As Object, objnSpace As Object, objFolder As Object
    Dim emailCount As Integer, DateCount As Integer, iCount As Integer
    Dim myDate As Date, i As Integer
    Dim arrEmailDates()
    
    ' Get Outlook Object
    Set objOutlook = CreateObject("Outlook.Application")
    Set objnSpace = objOutlook.GetNamespace("MAPI")
    
    ' Get Folder Object
    On Error Resume Next
    
    ' **** Set Folder Folder from Outlook structure ****
    ' **** Mailbox Name => Right-click on Inbox, Properties, Location: \\Mailbox Name
    ' **** Inbox
    ' **** FolderName
    ' **** SubFolderName
    ' **** Set objFolder = objnSpace.Folders("Mailbox").Folders("Inbox").Folders("FolderName").Folders("SubFolderName") ****
    
    ' **** Choose Folders
    Set objFolder = objnSpace.Folders("Mailbox").Folders("Inbox").Folders("FolderName").Folders("SubFolderName")
    
    If Err.Number <> 0 Then
        Err.Clear
        MsgBox "No such folder."
        Set objFolder = Nothing
        Set objnSpace = Nothing
        Set objOutlook = Nothing
        Exit Sub
    End If
    
    ' Put ReceivedTimes in array
    emailCount = objFolder.Items.Count
    For iCount = 1 To emailCount
        With objFolder.Items(iCount)
            ReDim Preserve arrEmailDates(iCount - 1)
            arrEmailDates(iCount - 1) = DateSerial(Year(.ReceivedTime), Month(.ReceivedTime), Day(.ReceivedTime))
        End With
    Next iCount
    
    ' Clear Outlook objects
    Set objFolder = Nothing
    Set objnSpace = Nothing
    Set objOutlook = Nothing

    ' Count the emails dates equal to active cell
    Sheets("CountMails").Range("A1").Select
    Do Until IsEmpty(ActiveCell)
        
        DateCount = 0
        myDate = ActiveCell.Value
        
        For i = 0 To UBound(arrEmailDates) - 1
            If arrEmailDates(i) = myDate Then DateCount = DateCount + 1
        Next i
         
        Selection.Offset(0, 1).Activate
        ActiveCell.Value = DateCount
        Selection.Offset(1, -1).Activate
    Loop
End Sub