Как бързо да преброите изпратените имейли по месеци във вашия Outlook

Ако съхранявате изпратените имейли в няколко папки и сега искате да преброите всички изпратени имейли по месец, можете да прочетете тази статия. Тук ще представим значително бърз начин да го получим.

Предишната статия - „Как бързо да преброите входящите имейли по дата, месец или година чрез Outlook VBA”Сподели начин за преброяване на имейли по месеци. Той обаче е в състояние да обработва имейлите в една папка. Ако искате да преброите имейлите в няколко или дори във всички пощенски папки, трябва да използвате другите средства. По този начин в следващите ще ви изложим още един много по-бърз начин.

Бройте изпратените имейли по месец

1. Като начало отворете редактора на Outlook VBA чрез „Alt + F11“.
2. След това активирайте препратката към „MS Excel Object Library ”според„Как да добавите Lib на обектrary Справка във VBA".
3. След това поставете следния VBA код в проект или модул.

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. След това преместете курсора в първата подпрограма.
5. След това натиснете „F5“, за да задействате този макрос.
6. Веднага ще се покаже файл на Excel, който съдържа броя на изпратените имейли за всеки месец, както е показано на фигурата по-долу.

Не се паникьосвайте пред корупцията в Outlook

Може да се притеснявате, когато срещнете PST щети. И все пак в действителност е по-добре да се успокоите възможно най-скоро. Както всички знаем, паниката е безпомощна и дори води до по-хаотични и сериозни проблеми. Трябва да запазите спокойствие, за да обмислите мерки, като например да помислите дали сте актуализирали резервно копие и да помислите как да го направите ремонт PST Дали да се прибягва до инструмент на трета страна като DataNumen Outlook Repair или се свържете със съответните специалисти.

Въведение на автора:

Шърли Джанг е експерт по възстановяване на данни в DataNumen, Inc., която е световен лидер в технологиите за възстановяване на данни, включително ремонт mdf и outlook софтуерни продукти за ремонт. За повече информация посетете WWW.datanumen.com