peermod
03-20-2017, 11:19 PM
Hi all,
Need you help. is that possible to add below scenario in the macro.
I am new to VBA(trying my best). Could you please help me.1) Is that possible to get every 15 minutes count of particular subject(if current time 9:00 AM means,i want 8:45 to 9:00 AM mail)
2) Is that possible to get count of unread mail of particular subject of every 20 minutes(if current time 9:00 AM means,i want 8:40 to 9:00 AM mail)
Code:
Sub CountInboxSubjects()
Dim olApp As Outlook.Application
Dim olNs As Outlook.Namespace
Dim olFldr As Outlook.MAPIFolder
Dim olMailItem As Outlook.MailItem
Dim propertyAccessor As Outlook.propertyAccessor
Dim olItem AsObject
Dim dic As Dictionary
Dim iOut AsLong
Dim Subject AsString
Dim iFolder AsLong
Dim i AsLong
Set olApp =New Outlook.Application
Set olNs = olApp.GetNamespace("MAPI")
With ActiveSheet
.Columns("A:C").Clear
.Range("A1:C1").Value = Array("Count","Subject","Folder")
iFolder =1
iOut =2
DoWhileTrue
SelectCase iFolder
Case1:Set olFldr = olNs.GetDefaultFolder(olFolderInbox)
Case2:Set olFldr = olNs.GetDefaultFolder(olFolderInbox).Folders("MrExcel")
CaseElse:ExitDo
EndSelect
Set dic =New Dictionary
ForEach olItem In olFldr.Items
If olItem.Class= olMail Then
Set propertyAccessor = olItem.propertyAccessor
Subject = propertyAccessor.GetProperty("")
If dic.Exists(Subject)Then dic(Subject)= dic(Subject)+1Else dic(Subject)=1
EndIf
Next olItem
For i =0To dic.Count -1
.Cells(iOut,"A")= dic.Items()(i)
.Cells(iOut,"B")= dic.Keys()(i)
.Cells(iOut,"C")= olFldr.Name
iOut = iOut +1
Next
iFolder = iFolder +1
Loop
EndWith
Need you help. is that possible to add below scenario in the macro.
I am new to VBA(trying my best). Could you please help me.1) Is that possible to get every 15 minutes count of particular subject(if current time 9:00 AM means,i want 8:45 to 9:00 AM mail)
2) Is that possible to get count of unread mail of particular subject of every 20 minutes(if current time 9:00 AM means,i want 8:40 to 9:00 AM mail)
Code:
Sub CountInboxSubjects()
Dim olApp As Outlook.Application
Dim olNs As Outlook.Namespace
Dim olFldr As Outlook.MAPIFolder
Dim olMailItem As Outlook.MailItem
Dim propertyAccessor As Outlook.propertyAccessor
Dim olItem AsObject
Dim dic As Dictionary
Dim iOut AsLong
Dim Subject AsString
Dim iFolder AsLong
Dim i AsLong
Set olApp =New Outlook.Application
Set olNs = olApp.GetNamespace("MAPI")
With ActiveSheet
.Columns("A:C").Clear
.Range("A1:C1").Value = Array("Count","Subject","Folder")
iFolder =1
iOut =2
DoWhileTrue
SelectCase iFolder
Case1:Set olFldr = olNs.GetDefaultFolder(olFolderInbox)
Case2:Set olFldr = olNs.GetDefaultFolder(olFolderInbox).Folders("MrExcel")
CaseElse:ExitDo
EndSelect
Set dic =New Dictionary
ForEach olItem In olFldr.Items
If olItem.Class= olMail Then
Set propertyAccessor = olItem.propertyAccessor
Subject = propertyAccessor.GetProperty("")
If dic.Exists(Subject)Then dic(Subject)= dic(Subject)+1Else dic(Subject)=1
EndIf
Next olItem
For i =0To dic.Count -1
.Cells(iOut,"A")= dic.Items()(i)
.Cells(iOut,"B")= dic.Keys()(i)
.Cells(iOut,"C")= olFldr.Name
iOut = iOut +1
Next
iFolder = iFolder +1
Loop
EndWith