antokout
10-02-2018, 01:23 AM
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
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