Copy emails from outlook to excel with VBA with specific subject and counting

Hello guys i have this code:
Dim olApp As Outlook.Application
Dim olNs As Outlook.Namespace
Dim olFldr As Outlook.MAPIFolder
Dim olMailItem As Outlook.MailItem
Dim olItem As Object
Dim dic As Dictionary
Dim i As Long
Dim Subject As String
Dim SoughtWord As String

Set olApp = New Outlook.Application
Set olNs = olApp.GetNamespace("MAPI")
Set olFldr = olNs.GetDefaultFolder(olFolderInbox)
Set dic = New Dictionary

SoughtWord = "Upgrade"

For Each olItem In olFldr.Items
If olItem.Class = olMail Then
Subject = olItem.Subject
If InStr(1, Subject, SoughtWord, vbTextCompare) > 0 Then
If dic.Exists(Subject) Then dic(Subject) = dic(Subject) + 1 Else dic(Subject) = 1
End If
End If
Next olItem


With ActiveSheet
.Columns("A:B").Clear
.Range("A1:B1").Value = Array("Count", "Subject")
For i = 0 To dic.Count - 1
.Cells(i + 2, "A") = dic.Items()(i)
.Cells(i + 2, "B") = dic.Keys()(i)
Next
End With


It worked only to copy inbox mails with specific subject "Upgrade" and count those.. I need to put and specific date on those maybe 7 days before to copy all emails with this subject
and to have a range on date can someone help me?
Thanks

This is a continuation of the discussion in http://www.vbaexpress.com/forum/show...tlook-to-excel Kindly don't start new threads on an existing topic of discussion. Thread closed. You may continue your discussion in the original thread.