Count emails from outlook

Tuesday, December 11, 2012 3:26 PM

I want to make vba script which count how many emails was received by date range, for each 30 min in my mailbox and in shared mailbox. Right now I make count which shows how many emails in each mailbox exist. But then I count inside each folder emails for each 30 min, I don't know why, but sometimes it count sometimes it not, and sometimes where more what 300 emails it does not count at all, and then I delete half of this emails it starts counting, but still in the end I get wrong numbers. Bellow sample of the code:

Option Explicit
 
Dim ws As Worksheet
Dim iRow As Integer
Dim xTime(0 To 47) As String
Dim i As Integer
Dim min As Integer
Dim x() As String
Dim d() As String
Dim myArray As Variant
Dim myArray1 As Variant
Dim y As Integer
Dim z As Integer
Dim e As Integer
Dim j As Integer

Const bTitles As Boolean = True ' do we want column titles?

Public Sub ListFolders()
 
  Dim objNS As Outlook.Namespace
  Dim objSentItemsFolder As Outlook.MAPIFolder
    
  Set ws = ActiveWorkbook.Sheets("Sheet1")
  'Set ws = ThisWorkbook.Sheets("Sheet1")
  Set objNS = Outlook.Application.GetNamespace("MAPI")

  ws.UsedRange.ClearContents
  iRow = IIf(bTitles, 1, 0)
  If bTitles Then ws.Range("A1:BE1") = _
  Array("Folder Path & Name", "Items", "", "Indented List Of Folders", "", "", "", "", "", _
  "12:00:00 AM/12:29:59 AM", "12:30:00 AM/12:59:59 AM", "1:00:00 AM/1:29:59 AM", "1:30:00 AM/1:59:59 AM", "2:00:00 AM/2:29:59 AM", _
  "2:30:00 AM/2:59:59 AM", "3:00:00 AM/3:29:59 AM", "3:30:00 AM/3:59:59 AM", "4:00:00 AM/3:29:59 AM", "4:30:00 AM/4:59:59 AM", _
  "5:00:00 AM/5:29:59 AM", "5:30:00 AM/5:59:59 AM", "6:00:00 AM/6:29:59 AM", "6:30:00 AM/6:59:59 AM", "7:00:00 AM/7:29:59 AM", _
  "7:30:00 AM/7:59:59 AM", "8:00:00 AM/8:29:59 AM", "8:30:00 AM/8:59:59 AM", "9:00:00 AM/9:29:59 AM", "9:30:00 AM/9:59:59 AM", _
  "10:00:00 AM/10:29:59 AM", "10:30:00 AM/10:59:59 AM", "11:00:00 AM/11:29:59 AM", "11:30:00 AM/11:59:59 AM", _
  "12:00:00 PM/12:29:59 PM", "12:30:00 PM/12:59:59 PM", "1:00:00 PM/1:29:59 PM", _
  "1:30:00 PM/1:59:59 PM", "2:00:00 PM/2:29:59 PM", "2:59:59 PM/2:59:59 PM", "3:00:00 PM/3:29:59 PM", _
  "3:30:00 PM/3:59:59 PM", "4:00:00 PM/4:29:59 PM", "4:30:00 PM/4:59:59 PM", "5:00:00 PM/5:29:59 PM", _
  "5:30:00 PM/5:59:59 PM", "6:00:00 PM/6:29:59 PM", _
  "6:30:00 PM/6:59:59 PM", "7:00:00 PM/7:29:59 PM", "7:30:00 PM/7:59:59 PM", _
  "8:00:00 PM/8:29:59 PM", "8:30:00 PM/8:59:59 PM", "9:00:00 PM/9:29:59 PM", "9:30:00 PM/9:59:59 PM", _
  "10:00:00 PM/10:29:59 PM", "10:30:00 PM/10:59:59 PM", "11:00:00 PM/11:29:59 PM", "11:30:00 PM/11:59:59 PM")
  ws.Range("A1:BE1").Font.Bold = bTitles
  
  ListFromFolder objNS, 1, ""
  
  ws.Cells(iRow + 1, 2) = "=SUM(B" & IIf(bTitles, "2", "1") & ":B" & CStr(iRow) & ")"
  ws.Cells(iRow + 1, 10) = "=SUM(J" & IIf(bTitles, "2", "1") & ":J" & CStr(iRow) & ")"
  ws.Cells(iRow + 1, 11) = "=SUM(K" & IIf(bTitles, "2", "1") & ":K" & CStr(iRow) & ")"
  ws.Cells(iRow + 1, 12) = "=SUM(L" & IIf(bTitles, "2", "1") & ":L" & CStr(iRow) & ")"
  ws.Cells(iRow + 1, 13) = "=SUM(M" & IIf(bTitles, "2", "1") & ":M" & CStr(iRow) & ")"
  ws.Cells(iRow + 1, 14) = "=SUM(N" & IIf(bTitles, "2", "1") & ":N" & CStr(iRow) & ")"
  ws.Cells(iRow + 1, 15) = "=SUM(O" & IIf(bTitles, "2", "1") & ":O" & CStr(iRow) & ")"
  ws.Cells(iRow + 1, 16) = "=SUM(P" & IIf(bTitles, "2", "1") & ":P" & CStr(iRow) & ")"
  ws.Cells(iRow + 1, 17) = "=SUM(Q" & IIf(bTitles, "2", "1") & ":Q" & CStr(iRow) & ")"
  ws.Cells(iRow + 1, 18) = "=SUM(R" & IIf(bTitles, "2", "1") & ":R" & CStr(iRow) & ")"
  ws.Cells(iRow + 1, 19) = "=SUM(S" & IIf(bTitles, "2", "1") & ":S" & CStr(iRow) & ")"
  ws.Cells(iRow + 1, 20) = "=SUM(T" & IIf(bTitles, "2", "1") & ":T" & CStr(iRow) & ")"
  ws.Cells(iRow + 1, 21) = "=SUM(U" & IIf(bTitles, "2", "1") & ":U" & CStr(iRow) & ")"
  ws.Cells(iRow + 1, 22) = "=SUM(V" & IIf(bTitles, "2", "1") & ":V" & CStr(iRow) & ")"
  ws.Cells(iRow + 1, 23) = "=SUM(W" & IIf(bTitles, "2", "1") & ":W" & CStr(iRow) & ")"
  ws.Cells(iRow + 1, 24) = "=SUM(X" & IIf(bTitles, "2", "1") & ":x" & CStr(iRow) & ")"
  ws.Cells(iRow + 1, 25) = "=SUM(Y" & IIf(bTitles, "2", "1") & ":Y" & CStr(iRow) & ")"
  ws.Cells(iRow + 1, 26) = "=SUM(Z" & IIf(bTitles, "2", "1") & ":Z" & CStr(iRow) & ")"
  ws.Cells(iRow + 1, 27) = "=SUM(AA" & IIf(bTitles, "2", "1") & ":AA" & CStr(iRow) & ")"
  ws.Cells(iRow + 1, 28) = "=SUM(AB" & IIf(bTitles, "2", "1") & ":AB" & CStr(iRow) & ")"
  ws.Cells(iRow + 1, 29) = "=SUM(AC" & IIf(bTitles, "2", "1") & ":AC" & CStr(iRow) & ")"
  ws.Cells(iRow + 1, 30) = "=SUM(AD" & IIf(bTitles, "2", "1") & ":AD" & CStr(iRow) & ")"
  ws.Cells(iRow + 1, 31) = "=SUM(AE" & IIf(bTitles, "2", "1") & ":AE" & CStr(iRow) & ")"
  ws.Cells(iRow + 1, 32) = "=SUM(AF" & IIf(bTitles, "2", "1") & ":AF" & CStr(iRow) & ")"
  ws.Cells(iRow + 1, 33) = "=SUM(AG" & IIf(bTitles, "2", "1") & ":AG" & CStr(iRow) & ")"
  ws.Cells(iRow + 1, 34) = "=SUM(AH" & IIf(bTitles, "2", "1") & ":AH" & CStr(iRow) & ")"
  ws.Cells(iRow + 1, 35) = "=SUM(AI" & IIf(bTitles, "2", "1") & ":AI" & CStr(iRow) & ")"
  ws.Cells(iRow + 1, 36) = "=SUM(AJ" & IIf(bTitles, "2", "1") & ":AJ" & CStr(iRow) & ")"
  ws.Cells(iRow + 1, 37) = "=SUM(AK" & IIf(bTitles, "2", "1") & ":AK" & CStr(iRow) & ")"
  ws.Cells(iRow + 1, 38) = "=SUM(AL" & IIf(bTitles, "2", "1") & ":AL" & CStr(iRow) & ")"
  ws.Cells(iRow + 1, 39) = "=SUM(AM" & IIf(bTitles, "2", "1") & ":AM" & CStr(iRow) & ")"
  ws.Cells(iRow + 1, 40) = "=SUM(AN" & IIf(bTitles, "2", "1") & ":AN" & CStr(iRow) & ")"
  ws.Cells(iRow + 1, 41) = "=SUM(AO" & IIf(bTitles, "2", "1") & ":AO" & CStr(iRow) & ")"
  ws.Cells(iRow + 1, 42) = "=SUM(AP" & IIf(bTitles, "2", "1") & ":AP" & CStr(iRow) & ")"
  ws.Cells(iRow + 1, 43) = "=SUM(AQ" & IIf(bTitles, "2", "1") & ":AQ" & CStr(iRow) & ")"
  ws.Cells(iRow + 1, 44) = "=SUM(AR" & IIf(bTitles, "2", "1") & ":AR" & CStr(iRow) & ")"
  ws.Cells(iRow + 1, 45) = "=SUM(AS" & IIf(bTitles, "2", "1") & ":AS" & CStr(iRow) & ")"
  ws.Cells(iRow + 1, 46) = "=SUM(AT" & IIf(bTitles, "2", "1") & ":AT" & CStr(iRow) & ")"
  ws.Cells(iRow + 1, 47) = "=SUM(AU" & IIf(bTitles, "2", "1") & ":AU" & CStr(iRow) & ")"
  ws.Cells(iRow + 1, 48) = "=SUM(AV" & IIf(bTitles, "2", "1") & ":AV" & CStr(iRow) & ")"
  ws.Cells(iRow + 1, 49) = "=SUM(AW" & IIf(bTitles, "2", "1") & ":AW" & CStr(iRow) & ")"
  ws.Cells(iRow + 1, 50) = "=SUM(AX" & IIf(bTitles, "2", "1") & ":AX" & CStr(iRow) & ")"
  ws.Cells(iRow + 1, 51) = "=SUM(AY" & IIf(bTitles, "2", "1") & ":AY" & CStr(iRow) & ")"
  ws.Cells(iRow + 1, 52) = "=SUM(AZ" & IIf(bTitles, "2", "1") & ":AZ" & CStr(iRow) & ")"
  ws.Cells(iRow + 1, 53) = "=SUM(BA" & IIf(bTitles, "2", "1") & ":BA" & CStr(iRow) & ")"
  ws.Cells(iRow + 1, 54) = "=SUM(BB" & IIf(bTitles, "2", "1") & ":BB" & CStr(iRow) & ")"
  ws.Cells(iRow + 1, 55) = "=SUM(BC" & IIf(bTitles, "2", "1") & ":BC" & CStr(iRow) & ")"
  ws.Cells(iRow + 1, 56) = "=SUM(BD" & IIf(bTitles, "2", "1") & ":BD" & CStr(iRow) & ")"
  ws.Cells(iRow + 1, 57) = "=SUM(BE" & IIf(bTitles, "2", "1") & ":BE" & CStr(iRow) & ")"
  
  ws.UsedRange.ColumnWidth = 4
  ws.Columns("A:B").AutoFit
  
  MsgBox "Done:-" & vbCrLf & vbCrLf _
       & CStr(iRow - IIf(bTitles, 1, 0)) & " folders listed" & Space(15) & vbCrLf & vbCrLf _
       & Format(ws.Cells(iRow + 1, 2), "#,##0") & " items counted", _
       vbOKOnly + vbInformation
  
  Set objNS = Nothing
  Set ws = Nothing
End Sub

Private Sub ListFromFolder(objFolderRoot As Object, argLevel As Integer, argFullName As String)
 
  Dim objFolder As MAPIFolder
  Dim myItem As Outlook.MailItem
  
'time frame devine
min = 0
    For i = 0 To 47
If i = 47 Then
    min = min + 29
    Else
    min = min + 30
End If
xTime(i) = Date & " " & TimeSerial(0, min, 0)
   ' MsgBox (xTime(i) & " " & i)
Next
  
  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
    
myArray = Array(Date & " 12:00:00 AM", xTime(0), xTime(2), xTime(3), xTime(4), xTime(5), xTime(6), xTime(7), _
xTime(8), xTime(9), xTime(10), xTime(11), xTime(12), xTime(13), xTime(14), xTime(15), xTime(16), xTime(17), xTime(18) _
, xTime(19), xTime(20), xTime(22), xTime(23), xTime(24), xTime(25), xTime(26), xTime(27), xTime(28), xTime(29), xTime(30), xTime(31) _
, xTime(32), xTime(33), xTime(34), xTime(35), xTime(36), xTime(37), xTime(38), xTime(39), xTime(40), xTime(41), xTime(42), xTime(43) _
, xTime(44), xTime(45), xTime(46), xTime(47)) 'define array

z = 0
e = 0

For y = LBound(myArray) To UBound(myArray) 'define start and end of array
  For Each myItem In objFolder.Items

    If myItem.ReceivedTime >= myArray(y) And myItem.ReceivedTime <= myArray(y + 1) Then
        e = e + 1
        ws.Cells(iRow, 10 + z) = e
    End If
    Next myItem
    z = z + 1
    e = 0
   ' MsgBox (myArray(y) & " " & myArray(y + 1))
Next y ' Loop!

    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 myItem = Nothing
  Set objFolder = Nothing
 
End Sub

I'm not pro so, don't judge me.

All Replies

Wednesday, December 12, 2012 9:41 AM

Moderator

0
Hi Arunas Girdziusas,

Thank you for posting in the MSDN Forum.

I've tried your code, however I cannot reproduce the scenario you've described.

I have 2 accounts added in my Outlook 2010, and the data for both are correct.

Could you please clarify which version of Outlook you are using?

I look forward to your reply.

Quist Zhang [MSFT]
MSDN Community Support | Feedback to us
Develop and promote your apps in Windows Store
Please remember to mark the replies as answers if they help and unmark them if they provide no help.
- Edited by Quist ZhangMicrosoft Contingent Staff, Moderator Wednesday, December 12, 2012 9:42 AM
- Reply
- Quote

Wednesday, December 12, 2012 1:11 PM

I use outlook and excel 2010, have 1 main and 2 shared mailbox. Each mailbox have folders, folders have insides folders.

This script I use in Excel 2010. Running in ThisWorkbook

I can't add images or links until my email address will be validated. I put screen shots asap then it will be valid.

I just make other simple script, but still don't have full results.

Option Explicit
 
Dim ws As Worksheet
Dim iRow As Integer
Dim j As Integer
Dim k As Integer
Dim l As Integer
Dim m As Integer
Dim n As Integer
Dim o As Integer
Dim p As Integer
Dim q As Integer
Dim r As Integer
Dim s As Integer
Dim t As Integer
Dim u As Integer
Dim v As Integer
Dim w As Integer
Dim x As Integer
Dim y As Integer
Dim z As Integer
Dim aa As Integer
Dim ab As Integer
Dim ac As Integer
Dim ad As Integer
Dim ae As Integer
Dim af As Integer
Dim ag As Integer
Dim ah As Integer
Dim ai As Integer
Dim aj As Integer
Dim ak As Integer
Dim al As Integer
Dim am As Integer
Dim an As Integer
Dim ao As Integer
Dim ap As Integer
Dim aq As Integer
Dim ar As Integer
Dim as1 As Integer
Dim at As Integer
Dim au As Integer
Dim av As Integer
Dim aw As Integer
Dim ax As Integer
Dim ay As Integer
Dim az As Integer
Dim ba As Integer
Dim bb As Integer
Dim bc As Integer
Dim bd As Integer
Dim be As Integer
  
Const bTitles As Boolean = True ' do we want column titles?
Dim frm1 As String
Dim frm2 As String
Dim frm3 As String
Dim frm4 As String
Dim frm5 As String
Dim frm6 As String
Dim frm7 As String
Dim frm8 As String
Dim frm9 As String
Dim frm10 As String
Dim frm11 As String
Dim frm12 As String
Dim frm13 As String
Dim frm14 As String
Dim frm15 As String
Dim frm16 As String
Dim frm17 As String
Dim frm18 As String
Dim frm19 As String
Dim frm20 As String
Dim frm21 As String
Dim frm22 As String
Dim frm23 As String
Dim frm24 As String
Dim frm25 As String
Dim frm26 As String
Dim frm27 As String
Dim frm28 As String
Dim frm29 As String
Dim frm30 As String
Dim frm31 As String
Dim frm32 As String
Dim frm33 As String
Dim frm34 As String
Dim frm35 As String
Dim frm36 As String
Dim frm37 As String
Dim frm38 As String
Dim frm39 As String
Dim frm40 As String
Dim frm41 As String
Dim frm42 As String
Dim frm43 As String
Dim frm44 As String
Dim frm45 As String
Dim frm46 As String
Dim frm47 As String
Dim frm48 As String
Dim frm49 As String
Dim frm50 As String
Dim frm51 As String
Dim frm52 As String
Dim frm53 As String
Dim frm54 As String
Dim frm55 As String
Dim frm56 As String
Dim frm57 As String
Dim frm58 As String
Dim frm59 As String
Dim frm60 As String
Dim frm61 As String
Dim frm62 As String
Dim frm63 As String
Dim frm64 As String
Dim frm65 As String
Dim frm66 As String
Dim frm67 As String
Dim frm68 As String
Dim frm69 As String
Dim frm70 As String
Dim frm71 As String
Dim frm72 As String
Dim frm73 As String
Dim frm74 As String
Dim frm75 As String
Dim frm76 As String
Dim frm77 As String
Dim frm78 As String
Dim frm79 As String
Dim frm80 As String
Dim frm81 As String
Dim frm82 As String
Dim frm83 As String
Dim frm84 As String
Dim frm85 As String
Dim frm86 As String
Dim frm87 As String
Dim frm88 As String
Dim frm89 As String
Dim frm90 As String
Dim frm91 As String
Dim frm92 As String
Dim frm93 As String
Dim frm94 As String
Dim frm95 As String
Dim frm96 As String

Public Sub ListFolders()
 
  Dim objNS As Outlook.Namespace
  Dim objSentItemsFolder As Outlook.MAPIFolder
  
  Set ws = ActiveWorkbook.Sheets("Sheet1")
  'Set ws = ThisWorkbook.Sheets("Sheet1")
  Set objNS = Outlook.Application.GetNamespace("MAPI")
  
 ' time frame
frm1 = Date & " 12:00:00 AM"
frm2 = Date & " 12:29:59 AM"
frm3 = Date & " 12:30:00 AM"
frm4 = Date & " 12:59:59 AM"

frm5 = Date & " 1:00:00 AM"
frm6 = Date & " 1:29:59 AM"
frm7 = Date & " 1:30:00 AM"
frm8 = Date & " 1:59:59 AM"

frm9 = Date & " 2:00:00 AM"
frm10 = Date & " 2:29:59 AM"
frm11 = Date & " 2:30:00 AM"
frm12 = Date & " 2:59:59 AM"

frm13 = Date & " 3:00:00 AM"
frm14 = Date & " 3:29:59 AM"
frm15 = Date & " 3:30:00 AM"
frm16 = Date & " 3:59:59 AM"

frm17 = Date & " 4:00:00 AM"
frm18 = Date & " 4:29:59 AM"
frm19 = Date & " 4:30:00 AM"
frm20 = Date & " 4:59:59 AM"

frm21 = Date & " 5:00:00 AM"
frm22 = Date & " 5:29:59 AM"
frm23 = Date & " 5:30:00 AM"
frm24 = Date & " 5:59:59 AM"

frm25 = Date & " 6:00:00 AM"
frm26 = Date & " 6:29:59 AM"
frm27 = Date & " 6:30:00 AM"
frm28 = Date & " 6:59:59 AM"

frm29 = Date & " 7:00:00 AM"
frm30 = Date & " 7:29:59 AM"
frm31 = Date & " 7:30:00 AM"
frm32 = Date & " 7:59:59 AM"

frm33 = Date & " 8:00:00 AM"
frm34 = Date & " 8:29:59 AM"
frm35 = Date & " 8:30:00 AM"
frm36 = Date & " 8:59:59 AM"

frm37 = Date & " 9:00:00 AM"
frm38 = Date & " 9:29:59 AM"
frm39 = Date & " 9:30:00 AM"
frm40 = Date & " 9:59:59 AM"

frm41 = Date & " 10:00:00 AM"
frm42 = Date & " 10:29:59 AM"
frm43 = Date & " 10:30:00 AM"
frm44 = Date & " 10:59:59 AM"

frm45 = Date & " 11:00:00 AM"
frm46 = Date & " 11:29:59 AM"

frm47 = Date & " 11:30:00 AM"
frm48 = Date & " 11:59:59 AM"
'------------------- time change PM -----------
frm49 = Date & " 12:00:00 PM"
frm50 = Date & " 12:29:59 PM"
frm51 = Date & " 12:30:00 PM"
frm52 = Date & " 12:59:59 PM"

frm53 = Date & " 1:00:00 PM"
frm54 = Date & " 1:29:59 PM"
frm55 = Date & " 1:30:00 PM"
frm56 = Date & " 1:59:59 PM"

frm57 = Date & " 2:00:00 PM"
frm58 = Date & " 2:29:59 PM"
frm59 = Date & " 2:30:00 PM"
frm60 = Date & " 2:59:59 PM"

frm61 = Date & " 3:00:00 PM"
frm62 = Date & " 3:29:59 PM"
frm63 = Date & " 3:30:00 PM"
frm64 = Date & " 3:59:59 PM"

frm65 = Date & " 4:00:00 PM"
frm66 = Date & " 4:29:59 PM"
frm67 = Date & " 4:30:00 PM"
frm68 = Date & " 4:59:59 PM"

frm69 = Date & " 5:00:00 PM"
frm70 = Date & " 5:29:59 PM"
frm71 = Date & " 5:30:00 PM"
frm72 = Date & " 5:59:59 PM"

frm73 = Date & " 6:00:00 PM"
frm74 = Date & " 6:29:59 PM"
frm75 = Date & " 6:30:00 PM"
frm76 = Date & " 6:59:59 PM"

frm77 = Date & " 7:00:00 PM"
frm78 = Date & " 7:29:59 PM"
frm79 = Date & " 7:30:00 PM"
frm80 = Date & " 7:59:59 PM"

frm81 = Date & " 8:00:00 PM"
frm82 = Date & " 8:29:59 PM"
frm83 = Date & " 8:30:00 PM"
frm84 = Date & " 8:59:59 PM"

frm85 = Date & " 9:00:00 PM"
frm86 = Date & " 9:29:59 PM"
frm87 = Date & " 9:30:00 PM"
frm88 = Date & " 9:59:59 PM"

frm89 = Date & " 10:00:00 PM"
frm90 = Date & " 10:29:59 PM"
frm91 = Date & " 10:30:00 PM"
frm92 = Date & " 10:59:59 PM"

frm93 = Date & " 11:00:00 PM"
frm94 = Date & " 11:29:59 PM"
frm95 = Date & " 11:30:00 PM"
frm96 = Date & " 11:59:59 PM"

  ws.UsedRange.ClearContents
  iRow = IIf(bTitles, 1, 0)
  If bTitles Then ws.Range("A1:BE1") = _
  Array("Folder Path & Name", "Items", "", "Indented List Of Folders", "", "", "", "", "", _
  "12:00:00 AM/12:29:59 AM", "12:30:00 AM/12:59:59 AM", "1:00:00 AM/1:29:59 AM", "1:30:00 AM/1:59:59 AM", "2:00:00 AM/2:29:59 AM", _
  "2:30:00 AM/2:59:59 AM", "3:00:00 AM/3:29:59 AM", "3:30:00 AM/3:59:59 AM", "4:00:00 AM/3:29:59 AM", "4:30:00 AM/4:59:59 AM", _
  "5:00:00 AM/5:29:59 AM", "5:30:00 AM/5:59:59 AM", "6:00:00 AM/6:29:59 AM", "6:30:00 AM/6:59:59 AM", "7:00:00 AM/7:29:59 AM", _
  "7:30:00 AM/7:59:59 AM", "8:00:00 AM/8:29:59 AM", "8:30:00 AM/8:59:59 AM", "9:00:00 AM/9:29:59 AM", "9:30:00 AM/9:59:59 AM", _
  "10:00:00 AM/10:29:59 AM", "10:30:00 AM/10:59:59 AM", "11:00:00 AM/11:29:59 AM", "11:30:00 AM/11:59:59 AM", _
  "12:00:00 PM/12:29:59 PM", "12:30:00 PM/12:59:59 PM", "1:00:00 PM/1:29:59 PM", _
  "1:30:00 PM/1:59:59 PM", "2:00:00 PM/2:29:59 PM", "2:59:59 PM/2:59:59 PM", "3:00:00 PM/3:29:59 PM", _
  "3:30:00 PM/3:59:59 PM", "4:00:00 PM/4:29:59 PM", "4:30:00 PM/4:59:59 PM", "5:00:00 PM/5:29:59 PM", _
  "5:30:00 PM/5:59:59 PM", "6:00:00 PM/6:29:59 PM", _
  "6:30:00 PM/6:59:59 PM", "7:00:00 PM/7:29:59 PM", "7:30:00 PM/7:59:59 PM", _
  "8:00:00 PM/8:29:59 PM", "8:30:00 PM/8:59:59 PM", "9:00:00 PM/9:29:59 PM", "9:30:00 PM/9:59:59 PM", _
  "10:00:00 PM/10:29:59 PM", "10:30:00 PM/10:59:59 PM", "11:00:00 PM/11:29:59 PM", "11:30:00 PM/11:59:59 PM")
  ws.Range("A1:BE1").Font.Bold = bTitles
  
  ListFromFolder objNS, 1, ""
  
  ws.Cells(iRow + 1, 2) = "=SUM(B" & IIf(bTitles, "2", "1") & ":B" & CStr(iRow) & ")"
  ws.Cells(iRow + 1, 10) = "=SUM(J" & IIf(bTitles, "2", "1") & ":J" & CStr(iRow) & ")"
  ws.Cells(iRow + 1, 11) = "=SUM(K" & IIf(bTitles, "2", "1") & ":K" & CStr(iRow) & ")"
  ws.Cells(iRow + 1, 12) = "=SUM(L" & IIf(bTitles, "2", "1") & ":L" & CStr(iRow) & ")"
  ws.Cells(iRow + 1, 13) = "=SUM(M" & IIf(bTitles, "2", "1") & ":M" & CStr(iRow) & ")"
  ws.Cells(iRow + 1, 14) = "=SUM(N" & IIf(bTitles, "2", "1") & ":N" & CStr(iRow) & ")"
  ws.Cells(iRow + 1, 15) = "=SUM(O" & IIf(bTitles, "2", "1") & ":O" & CStr(iRow) & ")"
  ws.Cells(iRow + 1, 16) = "=SUM(P" & IIf(bTitles, "2", "1") & ":P" & CStr(iRow) & ")"
  ws.Cells(iRow + 1, 17) = "=SUM(Q" & IIf(bTitles, "2", "1") & ":Q" & CStr(iRow) & ")"
  ws.Cells(iRow + 1, 18) = "=SUM(R" & IIf(bTitles, "2", "1") & ":R" & CStr(iRow) & ")"
  ws.Cells(iRow + 1, 19) = "=SUM(S" & IIf(bTitles, "2", "1") & ":S" & CStr(iRow) & ")"
  ws.Cells(iRow + 1, 20) = "=SUM(T" & IIf(bTitles, "2", "1") & ":T" & CStr(iRow) & ")"
  ws.Cells(iRow + 1, 21) = "=SUM(U" & IIf(bTitles, "2", "1") & ":U" & CStr(iRow) & ")"
  ws.Cells(iRow + 1, 22) = "=SUM(V" & IIf(bTitles, "2", "1") & ":V" & CStr(iRow) & ")"
  ws.Cells(iRow + 1, 23) = "=SUM(W" & IIf(bTitles, "2", "1") & ":W" & CStr(iRow) & ")"
  ws.Cells(iRow + 1, 24) = "=SUM(X" & IIf(bTitles, "2", "1") & ":x" & CStr(iRow) & ")"
  ws.Cells(iRow + 1, 25) = "=SUM(Y" & IIf(bTitles, "2", "1") & ":Y" & CStr(iRow) & ")"
  ws.Cells(iRow + 1, 26) = "=SUM(Z" & IIf(bTitles, "2", "1") & ":Z" & CStr(iRow) & ")"
  ws.Cells(iRow + 1, 27) = "=SUM(AA" & IIf(bTitles, "2", "1") & ":AA" & CStr(iRow) & ")"
  ws.Cells(iRow + 1, 28) = "=SUM(AB" & IIf(bTitles, "2", "1") & ":AB" & CStr(iRow) & ")"
  ws.Cells(iRow + 1, 29) = "=SUM(AC" & IIf(bTitles, "2", "1") & ":AC" & CStr(iRow) & ")"
  ws.Cells(iRow + 1, 30) = "=SUM(AD" & IIf(bTitles, "2", "1") & ":AD" & CStr(iRow) & ")"
  ws.Cells(iRow + 1, 31) = "=SUM(AE" & IIf(bTitles, "2", "1") & ":AE" & CStr(iRow) & ")"
  ws.Cells(iRow + 1, 32) = "=SUM(AF" & IIf(bTitles, "2", "1") & ":AF" & CStr(iRow) & ")"
  ws.Cells(iRow + 1, 33) = "=SUM(AG" & IIf(bTitles, "2", "1") & ":AG" & CStr(iRow) & ")"
  ws.Cells(iRow + 1, 34) = "=SUM(AH" & IIf(bTitles, "2", "1") & ":AH" & CStr(iRow) & ")"
  ws.Cells(iRow + 1, 35) = "=SUM(AI" & IIf(bTitles, "2", "1") & ":AI" & CStr(iRow) & ")"
  ws.Cells(iRow + 1, 36) = "=SUM(AJ" & IIf(bTitles, "2", "1") & ":AJ" & CStr(iRow) & ")"
  ws.Cells(iRow + 1, 37) = "=SUM(AK" & IIf(bTitles, "2", "1") & ":AK" & CStr(iRow) & ")"
  ws.Cells(iRow + 1, 38) = "=SUM(AL" & IIf(bTitles, "2", "1") & ":AL" & CStr(iRow) & ")"
  ws.Cells(iRow + 1, 39) = "=SUM(AM" & IIf(bTitles, "2", "1") & ":AM" & CStr(iRow) & ")"
  ws.Cells(iRow + 1, 40) = "=SUM(AN" & IIf(bTitles, "2", "1") & ":AN" & CStr(iRow) & ")"
  ws.Cells(iRow + 1, 41) = "=SUM(AO" & IIf(bTitles, "2", "1") & ":AO" & CStr(iRow) & ")"
  ws.Cells(iRow + 1, 42) = "=SUM(AP" & IIf(bTitles, "2", "1") & ":AP" & CStr(iRow) & ")"
  ws.Cells(iRow + 1, 43) = "=SUM(AQ" & IIf(bTitles, "2", "1") & ":AQ" & CStr(iRow) & ")"
  ws.Cells(iRow + 1, 44) = "=SUM(AR" & IIf(bTitles, "2", "1") & ":AR" & CStr(iRow) & ")"
  ws.Cells(iRow + 1, 45) = "=SUM(AS" & IIf(bTitles, "2", "1") & ":AS" & CStr(iRow) & ")"
  ws.Cells(iRow + 1, 46) = "=SUM(AT" & IIf(bTitles, "2", "1") & ":AT" & CStr(iRow) & ")"
  ws.Cells(iRow + 1, 47) = "=SUM(AU" & IIf(bTitles, "2", "1") & ":AU" & CStr(iRow) & ")"
  ws.Cells(iRow + 1, 48) = "=SUM(AV" & IIf(bTitles, "2", "1") & ":AV" & CStr(iRow) & ")"
  ws.Cells(iRow + 1, 49) = "=SUM(AW" & IIf(bTitles, "2", "1") & ":AW" & CStr(iRow) & ")"
  ws.Cells(iRow + 1, 50) = "=SUM(AX" & IIf(bTitles, "2", "1") & ":AX" & CStr(iRow) & ")"
  ws.Cells(iRow + 1, 51) = "=SUM(AY" & IIf(bTitles, "2", "1") & ":AY" & CStr(iRow) & ")"
  ws.Cells(iRow + 1, 52) = "=SUM(AZ" & IIf(bTitles, "2", "1") & ":AZ" & CStr(iRow) & ")"
  ws.Cells(iRow + 1, 53) = "=SUM(BA" & IIf(bTitles, "2", "1") & ":BA" & CStr(iRow) & ")"
  ws.Cells(iRow + 1, 54) = "=SUM(BB" & IIf(bTitles, "2", "1") & ":BB" & CStr(iRow) & ")"
  ws.Cells(iRow + 1, 55) = "=SUM(BC" & IIf(bTitles, "2", "1") & ":BC" & CStr(iRow) & ")"
  ws.Cells(iRow + 1, 56) = "=SUM(BD" & IIf(bTitles, "2", "1") & ":BD" & CStr(iRow) & ")"
  ws.Cells(iRow + 1, 57) = "=SUM(BE" & IIf(bTitles, "2", "1") & ":BE" & CStr(iRow) & ")"
  
  ws.UsedRange.ColumnWidth = 4
  ws.Columns("A:B").AutoFit
  
  MsgBox "Done:-" & vbCrLf & vbCrLf _
       & CStr(iRow - IIf(bTitles, 1, 0)) & " folders listed" & Space(15) & vbCrLf & vbCrLf _
       & Format(ws.Cells(iRow + 1, 2), "#,##0") & " items counted", _
       vbOKOnly + vbInformation
  
  Set objNS = Nothing
  Set ws = Nothing
  
End Sub
 
Private Sub ListFromFolder(objFolderRoot As Object, argLevel As Integer, argFullName As String)
 
  Dim objFolder As MAPIFolder
  Dim myItem As Outlook.MailItem
  Dim Count As Integer
  
  For Each objFolder In objFolderRoot.Folders
    DoEvents
    iRow = iRow + 1
    'Count = 0
    ' 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
        
        'Count by time 1 Team
j = 0
k = 0
l = 0
m = 0
n = 0
o = 0
p = 0
q = 0
r = 0
s = 0
t = 0
u = 0
v = 0
w = 0
x = 0
y = 0
z = 0
aa = 0
ab = 0
ac = 0
ad = 0
ae = 0
af = 0
ag = 0
ah = 0
ai = 0
aj = 0
ak = 0
al = 0
am = 0
an = 0
ao = 0
ap = 0
aq = 0
ar = 0
as1 = 0
at = 0
au = 0
av = 0
aw = 0
ax = 0
ay = 0
az = 0
ba = 0
bb = 0
bc = 0
bd = 0
be = 0
' from this one it must check each emails time and if it hit correct time frame it must make +1, and in the end count total emails which was per 30 min of this days.
    Set myItem = ActiveInspector.CurrentItem
       
       For Each myItem In objFolder.Items
        With myItem
  If .LastModificationTime >= frm1 And .LastModificationTime <= frm2 Then
        j = j + 1
       ElseIf .LastModificationTime >= frm3 And .LastModificationTime <= frm4 Then
        k = k + 1
        ElseIf .LastModificationTime >= frm5 And .LastModificationTime <= frm6 Then
        l = l + 1
        ElseIf .LastModificationTime >= frm7 And .LastModificationTime <= frm8 Then
        m = m + 1
        ElseIf .LastModificationTime >= frm9 And .LastModificationTime <= frm10 Then
        n = n + 1
        ElseIf .LastModificationTime >= frm11 And .LastModificationTime <= frm12 Then
        o = o + 1
        ElseIf .LastModificationTime >= frm13 And .LastModificationTime <= frm14 Then
        p = p + 1
        ElseIf .LastModificationTime >= frm15 And .LastModificationTime <= frm16 Then
        q = q + 1
        ElseIf .LastModificationTime >= frm17 And .LastModificationTime <= frm18 Then
        r = r + 1
        ElseIf .LastModificationTime >= frm19 And .LastModificationTime <= frm20 Then
        s = s + 1
        ElseIf .LastModificationTime >= frm21 And .LastModificationTime <= frm22 Then
        t = t + 1
        ElseIf .LastModificationTime >= frm23 And .LastModificationTime <= frm24 Then
        u = u + 1
        ElseIf .LastModificationTime >= frm25 And .LastModificationTime <= frm26 Then
        v = v + 1
        ElseIf .LastModificationTime >= frm27 And .LastModificationTime <= frm28 Then
        w = w + 1
        ElseIf .LastModificationTime >= frm29 And .LastModificationTime <= frm30 Then
        x = x + 1
        ElseIf .LastModificationTime >= frm31 And .LastModificationTime <= frm32 Then
        y = y + 1
        ElseIf .LastModificationTime >= frm33 And .LastModificationTime <= frm34 Then
        z = z + 1
        ElseIf .LastModificationTime >= frm35 And .LastModificationTime <= frm36 Then
        aa = aa + 1
        ElseIf .LastModificationTime >= frm37 And .LastModificationTime <= frm38 Then
        ab = ab + 1
        ElseIf .LastModificationTime >= frm39 And .LastModificationTime <= frm40 Then
        ac = ac + 1
        ElseIf .LastModificationTime >= frm41 And .LastModificationTime <= frm42 Then
        ad = ad + 1
        ElseIf .LastModificationTime >= frm43 And .LastModificationTime <= frm44 Then
        ae = ae + 1
        ElseIf .LastModificationTime >= frm45 And .LastModificationTime <= frm46 Then
        af = af + 1
        ElseIf .LastModificationTime >= frm47 And .LastModificationTime <= frm48 Then
        ag = ag + 1
        ElseIf .LastModificationTime >= frm49 And .LastModificationTime <= frm50 Then
        ah = ah + 1
        ElseIf .LastModificationTime >= frm51 And .LastModificationTime <= frm52 Then
        ai = ai + 1
        ElseIf .LastModificationTime >= frm53 And .LastModificationTime <= frm54 Then
        aj = aj + 1
        ElseIf .LastModificationTime >= frm55 And .LastModificationTime <= frm56 Then
        ak = ak + 1
        ElseIf .LastModificationTime >= frm57 And .LastModificationTime <= frm58 Then
        al = al + 1
        ElseIf .LastModificationTime >= frm59 And .LastModificationTime <= frm60 Then
        am = am + 1
        ElseIf .LastModificationTime >= frm61 And .LastModificationTime <= frm62 Then
        an = an + 1
        ElseIf .LastModificationTime >= frm63 And .LastModificationTime <= frm64 Then
        ao = ao + 1
        ElseIf .LastModificationTime >= frm65 And .LastModificationTime <= frm66 Then
        ap = ap + 1
        ElseIf .LastModificationTime >= frm67 And .LastModificationTime <= frm68 Then
        aq = aq + 1
        ElseIf .LastModificationTime >= frm69 And .LastModificationTime <= frm70 Then
        ar = ar + 1
        ElseIf .LastModificationTime >= frm71 And .LastModificationTime <= frm72 Then
        as1 = as1 + 1
        ElseIf .LastModificationTime >= frm73 And .LastModificationTime <= frm74 Then
        at = at + 1
        ElseIf .LastModificationTime >= frm75 And .LastModificationTime <= frm76 Then
        au = au + 1
        ElseIf .LastModificationTime >= frm77 And .LastModificationTime <= frm78 Then
        av = av + 1
        ElseIf .LastModificationTime >= frm79 And .LastModificationTime <= frm80 Then
        aw = aw + 1
        ElseIf .LastModificationTime >= frm81 And .LastModificationTime <= frm82 Then
        ax = ax + 1
        ElseIf .LastModificationTime >= frm83 And .LastModificationTime <= frm84 Then
        ay = ay + 1
        ElseIf .LastModificationTime >= frm85 And .LastModificationTime <= frm86 Then
        az = az + 1
        ElseIf .LastModificationTime >= frm87 And .LastModificationTime <= frm88 Then
        ba = ba + 1
        ElseIf .LastModificationTime >= frm89 And .LastModificationTime <= frm90 Then
        bb = bb + 1
        ElseIf .LastModificationTime >= frm91 And .LastModificationTime <= frm92 Then
        bc = bc + 1
        ElseIf .LastModificationTime >= frm93 And .LastModificationTime <= frm94 Then
        bd = bd + 1
        ElseIf .LastModificationTime >= frm95 And .LastModificationTime <= frm96 Then
        be = be + 1
        'Else: MsgBox "Error " & myItem
    End If
        End With
    Next myItem
    
    ws.Cells(iRow, 10) = j
    ws.Cells(iRow, 11) = k
    ws.Cells(iRow, 12) = l
    ws.Cells(iRow, 13) = m
    ws.Cells(iRow, 14) = n
    ws.Cells(iRow, 15) = o
    ws.Cells(iRow, 16) = p
    ws.Cells(iRow, 17) = r
    ws.Cells(iRow, 18) = s
    ws.Cells(iRow, 19) = t
    ws.Cells(iRow, 20) = u
    ws.Cells(iRow, 21) = v
    ws.Cells(iRow, 22) = w
    ws.Cells(iRow, 23) = x
    ws.Cells(iRow, 24) = y
    ws.Cells(iRow, 25) = aa
    ws.Cells(iRow, 26) = ab
    ws.Cells(iRow, 27) = ac
    ws.Cells(iRow, 28) = ad
    ws.Cells(iRow, 29) = af
    ws.Cells(iRow, 30) = ag
    ws.Cells(iRow, 31) = ah
    ws.Cells(iRow, 32) = ai
    ws.Cells(iRow, 33) = aj
    ws.Cells(iRow, 34) = ak
    ws.Cells(iRow, 35) = ag
    ws.Cells(iRow, 36) = ah
    ws.Cells(iRow, 37) = ai
    ws.Cells(iRow, 38) = ak
    ws.Cells(iRow, 39) = al
    ws.Cells(iRow, 40) = am
    ws.Cells(iRow, 41) = an
    ws.Cells(iRow, 42) = ao
    ws.Cells(iRow, 43) = ap
    ws.Cells(iRow, 44) = aq
    ws.Cells(iRow, 45) = ar
    ws.Cells(iRow, 46) = as1
    ws.Cells(iRow, 47) = at
    ws.Cells(iRow, 48) = au
    ws.Cells(iRow, 49) = av
    ws.Cells(iRow, 50) = aw
    ws.Cells(iRow, 51) = ax
    ws.Cells(iRow, 52) = ay
    ws.Cells(iRow, 53) = az
    ws.Cells(iRow, 54) = ba
    ws.Cells(iRow, 55) = bb
    ws.Cells(iRow, 56) = bc
    ws.Cells(iRow, 57) = bd
    
    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 myItem = Nothing
  Set objFolder = Nothing
 
End Sub

Edited by Arunas Girdziusas Wednesday, December 12, 2012 1:27 PM new code

Wednesday, December 19, 2012 11:49 AM

0
I think your problem lies in this piece of code:-

For Each myItem In objFolder.Items

I believe there is a memory leak when iterating over the items collection, I am constantly running ito this problem. Try replacing it with:-

For i=0 To objFolder.Items.Count-1

myItem=objFolder.Items(i)

Alan Moseley
- Edited by Alan Moseley Wednesday, December 19, 2012 11:49 AM Typo
- Reply
- Quote
Wednesday, December 19, 2012 2:09 PM

0

Just made this change on script and get in each row same value total of emails. No lock at this time.
- Reply
- Quote

Count emails from outlook

All Replies

Office 2013

Office Extensibility

Resources

Connect

Developer Centers

Information for