extracting Email from current date

Hi everyone,

I am using one vba to extract the email, can I add some code inside to extracting only the email of the current date?

Sub List_Email_Info()

Dim i As Long
' Row tracker
Dim arrHeader As Variant

Dim olNS As NameSpace
Dim olInboxFolder As MAPIFolder
Dim olItems As Items
Dim olMailItem As MailItem

arrHeader = Array("Date Created", "Subject", "Sender's Name", "Unread")

Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = True
Set xlWB = xlApp.Workbooks.Add

Set olNS = GetNamespace("MAPI")
Set olInboxFolder = olNS.GetDefaultFolder(olFolderInbox).folders("current folder")
Set olItems = olInboxFolder.Items



i = 1

On Error Resume Next

xlWB.Worksheets(1).Range("A1").Resize(1, UBound(arrHeader) + 1).Value = arrHeader

For Each olMailItem In olItems
    
    xlWB.Worksheets(1).Cells(i + 1, "A").Value = olItems(i).ReceivedTime
    xlWB.Worksheets(1).Cells(i + 1, "B").Value = olItems(i).Subject
    xlWB.Worksheets(1).Cells(i + 1, "C").Value = olItems(i).Body
    xlWB.Worksheets(1).Cells(i + 1, "D").Value = olItems(i).SentOnBehalfOfName
    
    i = i + 1
    
Next olMailItem

xlWB.Worksheets(1).Cells.EntireColumn.AutoFit

MsgBox "Export complete.", vbInformation

Set xlWB = Nothing
Set xlApp = Nothing

Set olItems = Nothing
Set olInboxFolder = Nothing
Set olNS = Nothing

End Sub

Thanks every expert!