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

[bgdan]

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.

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!

 

[bgdan]

So I got this far:

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

 

[Domenic]

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?

 

[bgdan]

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

 

[Domenic]

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...

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...

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...

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!

 

[bgdan]

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.