Counting up emails and sub folders in Outlook 2010

[Retrojay]

Afternoon all,

Is there anyway that Excel 2010 can count through a mailbox and it's subfolders and sort these emails into a worksheet on a button click?

The Mailbox is called 'Internet Sales Manager' and the folder structure in it look like this

Inbox > Sales Leads > Channel1 > Site1 >
Inbox > Sales Leads > Channel1 > Site2 >
Inbox > Sales Leads > Channel1 > Site3 >
Inbox > Sales Leads > Channel2 > Site1 >
Inbox > Sales Leads > Channel2 > Site2 >
Inbox > Sales Leads > Channel2 > Site3 >
Inbox > Sales Leads > Channel3 > Site1 >
Inbox > Sales Leads > Channel3 > Site2 >
Inbox > Sales Leads > Channel3 > Site3 >

I want to count them up in a spreadsheet, categorised by each of the Channels, by Site and by their Received Date.

So the data would be in this structure

Date - Channel1/Site1 Channel1/Site2 Channel1/Site3 Channel2/Site1 etc........
03/03/2014 5 3 1 5
04/03/2014 6 1 2 3

Am I flogging a dead horse here or do you think it's do-able?

I currently go through manually and count up all the email and put them in the corresponding fields, it takes forever and it would be so much easier if it counted them either when i clicked a button or when the Workbook opened?

I have seen some of the wondrous stuff that can be achieved on Excel and wondered if it could do something like this?

Thanks in advance for any input

Jay

 

[RCBricker]

Hi jay!

I am looking for a different solution than you are, but I found this code the other day and it is similar to what you want. I believe that it may give you more than you need. But it only takes a few seconds to run AND probably a few minutes for you to trim the data you do not want. It should help you save time while you look for a final solution.

Option Explicit
 
Dim ws As Worksheet
Dim iRow As Integer
Const bTitles As Boolean = True ' do we want column titles?
 
Public Sub ListFolders()
 
  Dim objNS As Outlook.Namespace
  
  Set ws = ThisWorkbook.Sheets("Sheet1")
  Set objNS = Outlook.Application.GetNamespace("MAPI")
  
  '============================================================================
    'CLEARS CONTENT OF DESTINATION WORKSHEET
  '============================================================================
  
     ws.UsedRange.ClearContents

  '============================================================================
    'ADDS HEADERS TOP OF THE WORKSHEET
  '============================================================================
  
    iRow = IIf(bTitles, 1, 0)
    If bTitles Then ws.Range("A1:C1") = Array("EMAIL NUMBER", "SENDEE", "TIME STAMP")
    ws.Range("A1:C1").Font.Bold = bTitles
    
  '============================================================================
    'CALLS SUB PROCEDURE
  '============================================================================
  
  ListFromFolder objNS, 1, ""

  '============================================================================
    'SIZES ENTIRE COLUMN RANGE
    'THEN AUTOFITS TO COLUMNS WITH DATA
  '============================================================================

  ws.UsedRange.ColumnWidth = 3
  ws.Columns("A:C").AutoFit
  
  Set objNS = Nothing
  Set ws = Nothing
  
End Sub
 
Private Sub ListFromFolder(objFolderRoot As Object, argLevel As Integer, argFullName As String)
 
  Dim objFolder As MAPIFolder
  
  For Each objFolder In objFolderRoot.Folders
    DoEvents
    iRow = iRow + 1
    ' full folder path in column A
    ws.Cells(iRow, 1) = argFullName & "\" & objFolder.Name
    ' count of items in folder in column B
    On Error Resume Next
    ws.Cells(iRow, 2) = objFolder.Items.Count
    On Error GoTo 0
    ' indented folder list in column C onwards
    ws.Cells(iRow, argLevel + 3) = objFolder.Name
    If objFolder.Folders.Count > 0 Then
      ListFromFolder objFolder, argLevel + 1, argFullName & "\" & objFolder.Name
    End If
  Next objFolder
  
  Set objFolder = Nothing
 
End Sub

rich

 

[Retrojay]

Rich,

That's awesome mate. It'll give me something to work on as a project over Christmas

I'll report back if I get it working properly, thank you for referring back to this for me.

Festive regards

Jason