Using Excel VBA to count mails in outlook

kazikamuntu

New Member
Joined
Jul 8, 2019
Messages
2
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 ?

Code:
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
 

Excel Facts

Can you sort left to right?
To sort left-to-right, use the Sort dialog box. Click Options. Choose "Sort left to right"
how can i sobstitute "Set objItems = Outlook.Application.ActiveExplorer.CurrentFolder.Items" whith my specific folder/subfolder ?
Replace it with:
Code:
    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.
 
Upvote 0
Hi Mr John

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

The modified code is as follows:

VBA Code:
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
 
Upvote 0
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
 
Upvote 0
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:

VBA Code:
Set NS = Application.GetNamespace("MAPI")
with:
VBA Code:
    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.
 
Upvote 0
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:

VBA Code:
Set NS = Application.GetNamespace("MAPI")
with:
VBA Code:
    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
 
Upvote 0
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:

VBA Code:
strReceivedDate = Year(dReceivedTime) & " - " & Month(dReceivedTime)
to
VBA Code:
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).
 
Upvote 0
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
 
Upvote 0

Forum statistics

Threads
1,224,824
Messages
6,181,186
Members
453,020
Latest member
Mohamed Magdi Tawfiq Emam

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
Back
Top