Guys please i need help,
How can i put specific date range on this code to show and the counter and specific sub lines i choose and the range date i want?
Guys please i need help,
How can i put specific date range on this code to show and the counter and specific sub lines i choose and the range date i want?
Sub EmailCounting() 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 Dim TheDate As Date Dim SoughtWord1 As String Set olApp = New Outlook.Application Set olNs = olApp.GetNamespace("MAPI") Set olFldr = olNs.GetDefaultFolder(olFolderInbox).Folders("Icinga") Set dic = New Dictionary SoughtWord = "CRITICAL" TheDate = InputBox("Enter a date") Soughtword1= "OK" For Each olItem In olFldr.Items If olItem.Class = olMail Then Subject = olItem.Subject If InStr(1, Subject, SoughtWord, vbTextCompare) > 0 Or InStr(1, Subject, SoughtWord1, 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:C") .Clear .Range("A1:C1").Value = Array("Count", "Subject", "Date") For i = 0 To dic.Count - 1 .Cells(i + 2, "A") = dic.Items()(i) .Cells(i + 2, "B") = dic.Keys()(i) .Cells(i + 2, "C") = Date Next End With End Sub
This is the code
Last edited by Paul_Hossler; 10-16-2018 at 08:07 AM. Reason: Formatted code, added CODE tags