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

Ako pohranjujete poslane e-poruke u nekoliko foldera i sada želite da brojite sve ove poslane poruke po mjesecima, možete pročitati ovaj članak. Ovdje ćemo predstaviti znatno brz način da ga dobijete.

Prethodni članak – “Kako brzo izbrojati dolazne e-poruke po datumu, mjesecu ili godini putem Outlook VBA” je podijelio način brojanja e-poruka po mjesecima. Međutim, može obraditi e-poštu u jednom folderu. Ako želite da brojite e-poštu u nekoliko ili čak u svim folderima pošte, trebali biste koristiti druga sredstva. Stoga ćemo vam u nastavku izložiti 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 Object Library Referenca u VBA".
3. Nakon toga, stavite sljedeći VBA kod u projekat 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 prvi potprogram.
5. Nakon toga, pritisnite “F5” da pokrenete ovaj makro.
6. Odjednom će se pojaviti Excel datoteka koja sadrži broj poslanih e-poruka svakog mjeseca, kao što je prikazano na slici ispod.

Nemojte paničariti pred korupcijom u Outlooku

Možda ćete biti zabrinuti kada naiđete na PST oštećenje. Ipak, u stvarnosti, bolje je da se smirite što je prije moguće. Kao što svi znamo, panika je bespomoćna i čak dovodi do haotičnijih i ozbiljnijih problema. Trebali biste ostati mirni da razmislite o mjerama, kao što je razmišljanje o tome da li ste ažurirali sigurnosnu kopiju i razmislite kako to učiniti popraviti PST – da li da pribegnete alatu treće strane kao što je DataNumen Outlook Repair ili kontaktirajte relevantne stručnjake.

Uvod za autora:

Shirley Zhang je stručnjak za oporavak podataka DataNumen, Inc., koji je svjetski lider u tehnologijama za oporavak podataka, uključujući popraviti mdf i Outlook softverski proizvodi za popravku. Za više informacija posjetite www.datanumen.com