如何在Outlook中按月快速計數已發送的電子郵件

如果您將已發送的電子郵件存儲在多個文件夾中，現在想按月統計所有已發送的電子郵件，則可以閱讀本文。 在這裡，我們將介紹一種相當快的獲取方法。

上一篇文章–如何通過Outlook VBA按日期，月份或年份快速計算傳入的電子郵件”共享了一種按月計數電子郵件的方法。 但是，它能夠在一個文件夾中處理電子郵件。 如果要計數幾個甚至所有郵件文件夾中的電子郵件，則應使用其他方法。 因此，在下文中，我們將向您提供另一種更快的方法。

按月份統計已發送的電子郵件

1. 首先，通過“ Alt + F11”訪問Outlook VBA編輯器。
2. 然後，啟用對“ MS Excel對像庫”的引用rary”，根據“如何添加對像庫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 或聯繫相關專業人士。

作者簡介：

Shirley Zhang是的數據恢復專家 DataNumen，Inc.是數據恢復技術的全球領導者，包括 維修MDF 和Outlook修復軟件產品。 欲了解更多信息，請訪問 萬維網。datanumen.COM