Как быстро подсчитать отправленные письма по месяцам в Outlook

Если вы храните отправленные письма в нескольких папках и теперь хотите посчитать все эти отправленные письма по месяцам, вы можете прочитать эту статью. Здесь мы представим довольно быстрый способ получить его.

Предыдущая статья — «Как быстро подсчитать входящие электронные письма по дате, месяцу или году через Outlook VBA” поделился способом подсчета писем по месяцам. Однако он может обрабатывать электронные письма в одной папке. Если вы хотите подсчитать электронные письма в нескольких или даже во всех почтовых папках, вам следует использовать другие средства. Таким образом, в дальнейшем мы представим вам еще один гораздо более быстрый способ.

Подсчет отправленных писем по месяцам

1. Для начала войдите в редактор Outlook VBA через «Alt + F11».
2. Затем включите ссылку на «MS Excel Object Librarу» в соответствии с «Как добавить объектную библиотеку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., которая является мировым лидером в области технологий восстановления данных, включая ремонт мдф и программные продукты для ремонта Outlook. Для получения дополнительной информации посетите www.datanumen.com