Count Outlook emails/attachments older than 30 days and put in excel

bgdan

New Member
Joined
Dec 9, 2016
Messages
4
Hi, I have some mailboxes in my Outlook, from where I need to count the total number of mails, the mails older than 30 days, and to get the date of the oldest email.
After that I need to put in these numbers in a excel sheet.

I have the following VBA code, that gets me the total number of emails and outputs the result to excel.
The problem is that I have no idea on how to get the number of emails older than 30 days, or the date of the oldest email.

Code:
Sub HowManyEmails()


    Dim objOutlook As Object, objnSpace As Object, objFolder As MAPIFolder
    Dim EmailCount As Integer
    Set objOutlook = CreateObject("Outlook.Application")
    Set objnSpace = objOutlook.GetNamespace("MAPI")


        On Error Resume Next
        Set objFolder1 = objnSpace.Folders("email@email.com").Folders("test")
        Set objFolder2 = objnSpace.Folders("email_2@email.com").Folders("Inbox")
       
        If Err.Number <> 0 Then
        Err.Clear
        MsgBox "No such folder."
        Exit Sub
        End If


    EmailCount1 = objFolder1.Items.Count
    EmailCount2 = objFolder2.Items.Count




    Sheets("Sheet1").Range("B2").Value = EmailCount1
    Sheets("Sheet1").Range("B3").Value = EmailCount2


    


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

Ideally, I would need a count of the number of attachments in the mailbox (also the number of attachments from emails older than 30 days).
At this moment, I estimate the number of attachments based on the email count.

Thank you!
 

Excel Facts

Can a formula spear through sheets?
Use =SUM(January:December!E7) to sum E7 on all of the sheets from January through December

bgdan

New Member
Joined
Dec 9, 2016
Messages
4
So I got this far:

Code:
Sub HowManyEmails()


Dim objOutlook As Object, objnSpace As Object, objFolder As MAPIFolder
Dim EmailCount As Integer




Set objOutlook = CreateObject("Outlook.Application")
Set objnSpace = objOutlook.GetNamespace("MAPI")


On Error Resume Next
        Set objFolder1 = objnSpace.Folders("Outlook Data File").Folders("Inbox")




 If Err.Number <> 0 Then
        Err.Clear
        MsgBox "No such folder."
        Exit Sub
        End If


For Each MailItem In objFolder1.Items
    If [COLOR=#ff0000]MailItem.ReceivedTime < (Date - 30)[/COLOR] Then EmailCount = EmailCount + 1
Next




Sheets("Sheet1").Range("C2").Value = EmailCount




Set objOutlook = Nothing
Set objnSpace = Nothing
Set objFolder = Nothing


End Sub

For some reason, this part: MailItem.ReceivedTime < (Date - 30) does not work as it should. I think it's because the ReceivedTime in Outlook contains also the hour/minute of the email received.
Can someone help?
Thanks
 
Upvote 0

Domenic

MrExcel MVP
Joined
Mar 10, 2004
Messages
20,914
Office Version
  1. 365
Platform
  1. Windows
For some reason, this part: MailItem.ReceivedTime < (Date - 30) does not work as it should. I think it's because the ReceivedTime in Outlook contains also the hour/minute of the email received.

Can you explain in what way it doesn't work?
 
Upvote 0

bgdan

New Member
Joined
Dec 9, 2016
Messages
4
I made a test folder in Outlook where I copied some emails. I have 6 emails older than 30 days, and the macro gives me the result:24.

I found this information here(link): since <code style="margin: 0px; padding: 1px 5px; border: 0px; font-family: Consolas, Menlo, Monaco, "Lucida Console", "Liberation Mono", "DejaVu Sans Mono", "Bitstream Vera Sans Mono", "Courier New", monospace, sans-serif; background-color: rgb(239, 240, 241); white-space: pre-wrap; color: rgb(36, 39, 41);">ReceivedTime</code> is Date / Time format, it will never equal a straight <code style="margin: 0px; padding: 1px 5px; border: 0px; font-family: Consolas, Menlo, Monaco, "Lucida Console", "Liberation Mono", "DejaVu Sans Mono", "Bitstream Vera Sans Mono", "Courier New", monospace, sans-serif; background-color: rgb(239, 240, 241); white-space: pre-wrap; color: rgb(36, 39, 41);">Date</code>.

But since that is Outlook VBA, I tried adapting it to excel, but I think I'm doing it wrong
 
Upvote 0

Domenic

MrExcel MVP
Joined
Mar 10, 2004
Messages
20,914
Office Version
  1. 365
Platform
  1. Windows
I found this information here(link): since <code style="margin: 0px; padding: 1px 5px; border: 0px; font-family: Consolas, Menlo, Monaco, "Lucida Console", "Liberation Mono", "DejaVu Sans Mono", "Bitstream Vera Sans Mono", "Courier New", monospace, sans-serif; background-color: rgb(239, 240, 241); white-space: pre-wrap; color: rgb(36, 39, 41);">ReceivedTime</code> is Date / Time format, it will never equal a straight <code style="margin: 0px; padding: 1px 5px; border: 0px; font-family: Consolas, Menlo, Monaco, "Lucida Console", "Liberation Mono", "DejaVu Sans Mono", "Bitstream Vera Sans Mono", "Courier New", monospace, sans-serif; background-color: rgb(239, 240, 241); white-space: pre-wrap; color: rgb(36, 39, 41);">Date</code>.

Yes, but in your example, you're not looking for an exact match. So it shouldn't be an issue. In your example, you have...

Code:
Date - 30

With today's date being 12/12/16, it returns 11/12/16. And since your statement is testing for dates prior to this date, it looks for emails that have a received time of 11/11/16 11:59:59 and earlier.

Maybe your code includes in the count other items, such as meeting items? If your intent is to narrow the count to just mail items, try...

Code:
For Each vItem In objFolder1.Items
    [COLOR=#ff0000]If TypeName(vItem) = "MailItem" Then[/COLOR]
        If vItem.ReceivedTime < (Date - 30) Then EmailCount = EmailCount + 1
    [COLOR=#ff0000]End If[/COLOR]
Next

On an aside, it looks like you've set a reference to the Outlook object library, yet for most of your object variables you've declare them as a generic object. I'd suggest that you use late binding, which means you can remove the reference to the Outlook object library. Also, it's good practice to declare all variables. Accordingly, here's revised copy of your code...

Code:
Option Explicit

Sub HowManyEmails()

    Dim objOutlook As Object, objnSpace As Object, objFolder As Object
    Dim vItem As Variant, EmailCount As Long
    
    Set objOutlook = CreateObject("Outlook.Application")
    Set objnSpace = objOutlook.GetNamespace("MAPI")
    
    On Error Resume Next
    Set objFolder = objnSpace.Folders("Outlook Data File").Folders("Inbox")
    If Err.Number <> 0 Then
        MsgBox "No such folder."
        Exit Sub
    End If
    On Error GoTo 0
    
    For Each vItem In objFolder.Items
        If TypeName(vItem) = "MailItem" Then
            If vItem.ReceivedTime < (Date - 30) Then EmailCount = EmailCount + 1
        End If
    Next
    
    Sheets("Sheet1").Range("C2").Value = EmailCount
    
    Set objOutlook = Nothing
    Set objnSpace = Nothing
    Set objFolder = Nothing

End Sub

Hope this helps!
 
Upvote 0

bgdan

New Member
Joined
Dec 9, 2016
Messages
4
When I did the test yesterday on my home computer, I used Outlook synchronized to my Gmail account. For some reason, it didn't work.
I tried again the same code today on my work mailbox, and IT WORKS! :)
I have no idea why it didn't work to begin with :(

To answer your question, my only intent is to count the attachments.
But since I have no idea where to start from, I'm counting the emails, which is less then perfect, but it works.

In any case, thanks for the tip with the Outlook object library. Now I don't need to add it manually each time.
I'm trying your code and will come back.
 
Upvote 0

Forum statistics

Threads
1,191,353
Messages
5,986,162
Members
440,007
Latest member
cjw29209

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top