Kako brzo prebrojati poslane e-poruke po mjesecima u vašem Outlooku

Ako pohranjujete poslane e-poruke u nekoliko mapa, a sada želite prebrojati sve te poslane e-poruke po mjesecima, možete pročitati ovaj članak. Ovdje ćemo predstaviti prilično brz način da ga dobijete.

Prethodni članak – “Kako brzo prebrojati dolazne e-poruke po datumu, mjesecu ili godini putem Outlook VBA” podijelio je način brojanja e-pošte po mjesecima. Međutim, može obraditi e-poštu u jednoj mapi. Ako želite prebrojati e-poštu u nekoliko ili čak u svim mapama pošte, trebali biste upotrijebiti drugi način. Stoga ćemo vam u nastavku otkriti još jedan mnogo brži način.

Brojite poslane e-poruke po mjesecima

1. Za početak, pristupite Outlook VBA editoru preko “Alt + F11”.
2. Zatim omogućite referencu na “MS Excel Object Library" prema "Kako dodati biblioteku objekatarary Referenca u VBA".
3. Nakon toga stavite sljedeći VBA kod u projekt ili modul.

Dim objDictionary As Object

Sub CountSentMailsByMonth()
    Dim objOutlookFile As Outlook.Folder
    Dim objFolder As Outlook.Folder
    Dim objExcelApp As Excel.Application
    Dim objExcelWorkbook As Excel.Workbook
    Dim objExcelWorksheet As Excel.Worksheet
    Dim varMonths As Variant
    Dim varItemCounts As Variant
    Dim nLastRow As Integer
 
    Set objDictionary = CreateObject("Scripting.Dictionary")
    Set objInbox = Outlook.Application.Session.GetDefaultFolder(olFolderInbox)
 
    'Get the default Outlook data file
    Set objOutlookFile = Outlook.Application.Session.GetDefaultFolder(olFolderInbox).Parent
 
    For Each objFolder In objOutlookFile.Folders
        If objFolder.DefaultItemType = olMailItem Then
           Call ProcessFolders(objFolder)
        End If
    Next

    Set objExcelApp = CreateObject("Excel.Application")
    objExcelApp.Visible = True
    Set objExcelWorkbook = objExcelApp.Workbooks.Add
    Set objExcelWorksheet = objExcelWorkbook.Sheets(1)
 
    With objExcelWorksheet
        .Cells(1, 1) = "Month"
        .Cells(1, 2) = "Count"
    End With
 
    varMonths = objDictionary.Keys
    varItemCounts = objDictionary.Items
 
    For i = LBound(varMonths) To UBound(varMonths)
        nLastRow = objExcelWorksheet.Range("A" & objExcelWorksheet.Rows.Count).End(xlUp).Row + 1
        With objExcelWorksheet
            .Cells(nLastRow, 1) = varMonths(i)
            .Cells(nLastRow, 2) = varItemCounts(i)
        End With
    Next
 
    objExcelWorksheet.Columns("A:B").AutoFit
End Sub

Sub ProcessFolders(ByVal objCurFolder As Outlook.Folder)
    Dim i As Long
    Dim objMail As Outlook.MailItem
    Dim strMonth As String
 
    For i = objCurFolder.Items.Count To 1 Step -1
        If objCurFolder.Items(i).Class = olMail Then
           Set objMail = objCurFolder.Items(i)
           'Change to your own email address
           If objMail.SenderEmailAddress = "you@datanumen.com" Then
              strMonth = Format(Year(objMail.SentOn) & "-" & Month(objMail.SentOn), "YYYY/MM")
 
              If objDictionary.Exists(strMonth) Then
                 objDictionary(strMonth) = objDictionary(strMonth) + 1
              Else
                 objDictionary.Add strMonth, 1
              End If
           End If
       End If
    Next
End Sub

4. Zatim pomaknite kursor u prvu potprogram.
5. Nakon toga pritisnite “F5” za pokretanje ove makronaredbe.
6. Odmah će se pojaviti Excel datoteka koja sadrži broj poslanih e-poruka u svakom mjesecu, kao što je prikazano na slici ispod.

Nemojte paničariti pred oštećenjem Outlooka

Možda ćete biti zabrinuti kada naiđete na oštećenje PST-a. Ipak, u stvarnosti bi vam bilo bolje da se što prije smirite. Kao što svi znamo, panika je bespomoćna i čak vodi u kaotičnije i ozbiljnije probleme. Trebali biste ostati mirni kako biste razmotrili mjere, kao što je razmišljanje o tome jeste li ažurirali sigurnosnu kopiju i razmotrite kako to učiniti popraviti PST – treba li pribjeći alatu treće strane poput DataNumen Outlook Repair ili se obratite relevantnim stručnjacima.

Uvod za autora:

Shirley Zhang stručnjakinja je za oporavak podataka u DataNumen, Inc., koji je svjetski lider u tehnologijama za oporavak podataka, uključujući popravak mdf-a i softverske proizvode za popravak Outlooka. Za više informacija posjetite www.datanumen.com