none
Count emails from outlook

    Question

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


    Tuesday, December 11, 2012 3:26 PM

All replies

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

    Wednesday, December 12, 2012 9:41 AM
    Moderator
  • 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
    

    Wednesday, December 12, 2012 1:11 PM
  • 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
    Wednesday, December 19, 2012 11:49 AM
  • Just made this change on script and get in each row same value total of emails. No lock at this time.
    Wednesday, December 19, 2012 2:09 PM