Using Excel VBA to count mails in outlook

[kazikamuntu]

Hi to all

I want to count mails in outlook in a specific month in specific folders (of outlook) using excel vba, I alrealdy tried a code in this thread
https://www.mrexcel.com/forum/excel-questions/293671-count-emails-outlook.html

but is very very slow.


I tried this code in outlook-vba and it is very fast.... How can i use that code in Excel?
I added excel and outlook references but it's not working.

how can i sobstitute "Set objItems = Outlook.Application.ActiveExplorer.CurrentFolder.Items" whith my specific folder/subfolder ?

Sub count()
    Dim objItems As Outlook.Items
    Dim objItem As Object
    Dim objMail As Outlook.MailItem
    Dim strMonth As String
    Dim dReceivedTime As Date
    Dim strReceivedDate As String
    Dim i, n As Long
    Dim strMsg As String
    Dim nPrompt As Integer
 
    Set objItems = Outlook.Application.ActiveExplorer.CurrentFolder.Items
 
    objItems.SetColumns ("ReceivedTime")
    strMonth = InputBox("Enter the specific month.(Format: yyyy-mm-dd)", "Specify month")
 
    If strMonth <> "" Then
       n = 0
       For i = 1 To objItems.Count
           If objItems.Item(i).Class = olMail Then
              Set objMail = objItems.Item(i)
              dReceivedTime = objMail.ReceivedTime
              strReceivedDate = Year(dReceivedTime) & " - " & Month(dReceivedTime)
              If strReceivedDate = strMonth Then
                 n = n + 1
              End If
           End If
       Next i
 
       strMsg = "You have received " & n & " emails on " & strMonth & "."
       nPrompt = MsgBox(strMsg, vbExclamation, "Count Received Emails")
    Else
       nPrompt = MsgBox("Please input the specific day!", vbExclamation)
    End If
End Sub

 

[John_w]

how can i sobstitute "Set objItems = Outlook.Application.ActiveExplorer.CurrentFolder.Items" whith my specific folder/subfolder ?

Replace it with:

    Dim NS As NameSpace
    Dim folder As MAPIFolder
    
    Set NS = Application.GetNamespace("MAPI")
    
    Set folder = NS.Folders("AccountName").Folders("Folder Name").Folders("Subfolder").Folders("Subfolder")
    Set objItems = folder.Items

changing/adding/removing the account name and folders in the Set folder line as required.

 

[kazikamuntu]

thank you john_w it works loke a charm !!!!

 

[buvanamali]

Hi Mr John

I tried as advised but I am getting runtime error:'438'

The modified code is as follows:

Sub count()
    Dim objItems As Outlook.Items
    Dim objItem As Object
    Dim objMail As Outlook.MailItem
    Dim strMonth As String
    Dim dReceivedTime As Date
    Dim strReceivedDate As String
    Dim i, n As Long
    Dim strMsg As String
    Dim nPrompt As Integer
    Dim NS As Namespace
    Dim folder As MAPIFolder

    Set NS = Application.GetNamespace("MAPI")   [COLOR=rgb(226, 80, 65)]---> Here I am getting error:'438'[/COLOR]
    
    Set folder = NS.Folders("xxxxx@gmail.com").Folders("Inbox") '.Folders("Subfolder").Folders("Subfolder")
    Set objItems = folder.Items

    objItems.SetColumns ("ReceivedTime")
    strMonth = InputBox("Enter the specific month.(Format: yyyy-mm-dd)", "Specify month")
 
    If strMonth <> "" Then
       n = 0
       For i = 1 To objItems.count
           If objItems.Item(i).Class = olMail Then
              Set objMail = objItems.Item(i)
              dReceivedTime = objMail.ReceivedTime
              strReceivedDate = Year(dReceivedTime) & " - " & Month(dReceivedTime)
              If strReceivedDate = strMonth Then
                 n = n + 1
              End If
           End If
       Next i
 
       strMsg = "You have received " & n & " emails on " & strMonth & "."
       nPrompt = MsgBox(strMsg, vbExclamation, "Count Received Emails")
    Else
       nPrompt = MsgBox("Please input the specific day!", vbExclamation)
    End If
End Sub

Could you please help me in resolving the issue.

Advance thanks.

Stay safe. Work Safe.

buvanamali

 

[John_w]

Welcome to MrExcel forums.

I tried as advised but I am getting runtime error:'438'

On which line?

 

[buvanamali]

Welcome to MrExcel forums.On which line?

I am getting error in the below mentioned line.

Set NS = Application.GetNamespace("MAPI") '---> Here I am getting error:'438'

The entire modified code as advised is given above. Please help me in resolving this issue.

Advance thanks

Stay Safe. Work Safe.

buvanamali

 

[John_w]

As stated in the OP, the code is meant to be placed in an Outlook VBA module and run from Outlook.

If you want to run it from an Excel VBA module then replace:

Set NS = Application.GetNamespace("MAPI")

with:

    Dim OutApp As Outlook.Application
   
    On Error Resume Next
    Set OutApp = GetObject(, "Outlook.Application")
    If Err.Number = 429 Then
        Set OutApp = CreateObject("Outlook.Application")
    End If
    On Error GoTo 0
   
    Set NS = OutApp.GetNamespace("MAPI")

Apart from that the code has several issues which make it difficult to use from a user's point of view.

 

[buvanamali]

As stated in the OP, the code is meant to be placed in an Outlook VBA module and run from Outlook.

If you want to run it from an Excel VBA module then replace:

Set NS = Application.GetNamespace("MAPI")

with:

    Dim OutApp As Outlook.Application
  
    On Error Resume Next
    Set OutApp = GetObject(, "Outlook.Application")
    If Err.Number = 429 Then
        Set OutApp = CreateObject("Outlook.Application")
    End If
    On Error GoTo 0
  
    Set NS = OutApp.GetNamespace("MAPI")

Apart from that the code has several issues which make it difficult to use from a user's point of view.

Dear Mr John

Thank you for your immediate response. Now it is working without error. However the result comes as 0 mails for given date (yyyy-mm-dd).
For your information, I had changed the folder information as below without including subfolders. Am I correct?

Set folder = NS.Folders("xxxxx@gmail.com").Folders("Inbox")

One more guidance, instead of having the count in message box, let it write to excel sheet in A2-Date, B2-Count of emails in Inbox.

Advance thanks

Stay Safe. Work Safe.

buvanamali

 

[John_w]

The code, as written - and it is badly written on several counts - requires the user to input the year and month in the format "yyyy - mm" for double digit months, or "yyyy - m" for single digit months (without the quotes) and with a space on both sides of the hyphen! Note year and month number is required in one of those exact formats, not just month or yyyy-mm-dd as the prompt wrongly says.

If you change this line:

strReceivedDate = Year(dReceivedTime) & " - " & Month(dReceivedTime)

to

strReceivedDate = Format(dReceivedTime, "yyyy-mm")

Then the user can input the required year and month in the more sensible format "yyyy-mm" (always 2 digits for the month).

 

[buvanamali]

Dear Mr John

Its amazing. Beautifully working. Thanks a lot once again.

One more help

Instead of having the count in message box, can you help me to write it to excel sheet in
Col A Col B
02-2020

Stay Safe. Work Safe.

buvanamali