PDA

View Full Version : Noob working with outlook VBA - emails marked "completed"



auto_mach
05-03-2015, 07:51 PM
Hi, everyone!

I found this code elsewhere online and modified it to fit my needs, but I need some help to get the last kink out of it.

For some more info on my needs, I have to check several mailboxes at work for a daily report and this code does everything I need save for one little thing.

As you can see, I exclude all emails marked as "completed." Since these mailboxes are handled by other parties, I'm unable to run rules and move the emails myself. I am only able to count them for my report.


Sub email_count()

Dim objOutlook As Object, objnSpace As Object, objFolder As MAPIFolder
Dim EmailCount As Integer, CompCount As Integer
Dim strFolder As String
Dim olMailItem As Outlook.MailItem
Set objOutlook = CreateObject("Outlook.Application")
Set objnSpace = objOutlook.GetNamespace("MAPI")
CompCount = 0

On Error Resume Next
Set objFolder = Application.GetNamespace("MAPI").Folders("Mailbox Name").Folders("Inbox")
If Err.Number <> 0 Then
Err.Clear
MsgBox "No such folder."
Exit Sub
End If
strFolder = objFolder.Parent
EmailCount = objFolder.Items.Count
For Each olMailItem In objFolder.Items
If olMailItem.TaskCompletedDate = "1/1/4501" Then
GoTo Line1
Else
CompCount = CompCount + 1
End If
Line1:
Next olMailItem


MsgBox "Number of emails in " & strFolder & ": " & (EmailCount - CompCount), , "email count"

Dim dateStr As String
Dim myItems As Outlook.Items
Dim dict As Object
Dim msg As String
Set dict = CreateObject("Scripting.Dictionary")
Set myItems = objFolder.Items
myItems.SetColumns ("ReceivedTime")
' Determine date of each message:
For Each myItem In myItems
dateStr = GetDate(myItem.ReceivedTime)
If Not dict.Exists(dateStr) Then
dict(dateStr) = 0
End If
dict(dateStr) = CLng(dict(dateStr)) + 1
Next myItem

' Output counts per day:
msg = ""
For Each o In dict.Keys
msg = msg & o & ": " & dict(o) & " items" & vbCrLf
Next

Dim fso As Object
Dim fo As Object

Set fso = CreateObject("Scripting.FileSystemObject")
Set fo = fso.CreateTextFile("[Path]\mail_log.txt")
fo.Write msg
fo.Close

Set fo = Nothing
Set fso = Nothing
Set objFolder = Nothing
Set objnSpace = Nothing
Set objOutlook = Nothing
End Sub



Function GetDate(dt As Date) As String
GetDate = Year(dt) & "-" & Month(dt) & "-" & Day(dt)
End Function

Whatever I try, I can't get a way to exclude the completed items from the final count that goes to the txt files.

Help?

gmayor
05-03-2015, 09:02 PM
For Each olMailItem In objFolder.Items
If Not InStr(1, olMailItem.TaskCompletedDate, "1/1/4501") Then
CompCount = CompCount + 1
End If
Next olMailItem


will eliminate the items as you intended. Whether this will give the results you require I cannot say.
Note that you are already working in Outlook so there is no need to create another Outlook object to run the code in.
I haven't looked at the rest of your code.

auto_mach
05-04-2015, 06:51 AM
Thanks, I was wondering about that myself. Like I said, I just modified a little of the code from what I found elsewhere.

That section is working properly and gives me the count as needed, but the following code is where I need to do the same.

For Each myItem In myItems
dateStr = GetDate(myItem.ReceivedTime)
If Not dict.Exists(dateStr) Then
dict(dateStr) = 0
End If
dict(dateStr) = CLng(dict(dateStr)) + 1
Next myItem
I tried altering that as well, but I figure only MailItems carry that attribute. What I attempted was to use MailItems in this section as well, but it would only count 1, no matter what.