如何在 Outlook 中統計每月寄出的電子郵件數量？

作者曉陽修改日期2024-09-18

有時，您可能想了解每月寄出了多少封電子郵件。本教學將為您介紹一段 VBA 程式碼，協助您輕鬆統計 Outlook 中每月寄出的郵件數量。

使用 VBA 程式碼在 Outlook 中統計每月寄出的電子郵件數量

請套用以下 VBA 程式碼，以取得如下圖所示的每月寄出電子郵件數量：

1. 按住 ALT + F11 鍵，即可開啟 Microsoft Visual Basic for Applications 視窗！

2. 點選插入＞模組，並將下列程式碼貼到模組視窗中。

VBA 程式碼：統計每月寄出的電子郵件數量：

Dim GDictionary As Object
Sub CountSentMailsByMonth()
'Updateby Extendoffice
Dim xSentFolder As Outlook.Folder
Dim xExcelApp As Excel.Application
Dim xWb As Excel.Workbook
Dim xWs As Excel.Worksheet
Dim xMonths As Variant
Dim xItemsCount As Variant
Dim xLastRow As Integer
Dim I As Integer
Dim xAccount As Account
On Error Resume Next
Set GDictionary = CreateObject("Scripting.Dictionary")
For Each xAccount In Application.Session.Accounts
  If VBA.LCase$(xAccount.SmtpAddress) = VBA.LCase$("yy@addin99.com") Then  'Specify the Email Account
    Set xSentFolder = xAccount.DeliveryStore.GetDefaultFolder(olFolderSentMail)
    If xSentFolder.DefaultItemType = olMailItem Then
      Call ProcessFolders(xSentFolder)
    End If
  End If
Next
Set xSentFolder = Nothing
Set xExcelApp = CreateObject("Excel.Application")
xExcelApp.Visible = True
Set xWb = xExcelApp.Workbooks.Add
Set xWs = xWb.Sheets(1)
With xWs
  .Cells(1, 1) = "Month"
  .Cells(1, 2) = "Count"
  .Cells(1, 1).Font.Bold = True
  .Cells(1, 2).Font.Bold = True
  .Cells(1, 1).HorizontalAlignment = xlCenter
  .Cells(1, 2).VerticalAlignment = xlCenter
End With
xMonths = GDictionary.Keys
xItemsCount = GDictionary.Items
For I = LBound(xMonths) To UBound(xMonths)
  xLastRow = xWs.Range("A" & xWs.Rows.Count).End(xlUp).Row + 1
  With xWs
    .Cells(xLastRow, 1) = xMonths(I)
    .Cells(xLastRow, 2) = xItemsCount(I)
  End With
Next
xWs.Columns("A:B").AutoFit
xExcelApp.Visible = True
Set xExcelApp = Nothing
Set xWb = Nothing
Set xWs = Nothing
End Sub

Sub ProcessFolders(ByVal Fld As Outlook.Folder)
Dim I As Long
Dim xMail As Outlook.MailItem
Dim xMonth As String
Dim xSubFolder As Folder
On Error Resume Next
For I = Fld.Items.Count To 1 Step -1
  If Fld.Items(I).Class = olMail Then
    Set xMail = Fld.Items(I)
    xMonth = Year(xMail.SentOn) & "/" & Month(xMail.SentOn)
    If GDictionary.Exists(xMonth) Then
      GDictionary(xMonth) = GDictionary(xMonth) + 1
    Else
      GDictionary.Add xMonth, 1
    End If
  End If
Next
If Fld.Folders.Count > 0 Then
  For Each xSubFolder In Fld.Folders
    Call ProcessFolders(xSubFolder)
  Next
End If
End Sub

注意：請在程式碼中將電子郵件帳戶「yy@addin 99.com」替換為您自己的帳戶名稱。

3. 仍在 Microsoft Visual Basic for Applications 視窗中，點選工具＞參考，在參考－專案對話方塊中，從可用參考清單中勾選 Microsoft Excel 16.0 物件庫 項目，如截圖所示：

doc-count-sent-emails-per-month-1

4. 接著點選確定關閉對話方塊，並按下 F5 鍵執行此程式碼，隨即開啟一個 Excel 檔案，顯示指定帳戶每月寄出電子郵件的統計數量，如截圖所示：

doc-count-sent-emails-per-month-2

Outlook 中的 AI 郵件助理：聰明回覆、清晰溝通，一鍵輕鬆搞定！

透過 Kutools for Outlook 的 AI 郵件助理，輕鬆簡化您每日的 Outlook 工作！這款強大工具能學習您過往的郵件內容，提供智慧又精準的回覆建議、優化郵件文字，並協助您毫不費力地起草與潤飾訊息。

此功能支援：

智慧回覆：根據您過往的對話，量身打造精準到位的回應，立即可用。
內容強化：自動優化您的郵件文字，提升清晰度與影響力。
輕鬆撰寫：只需提供關鍵字，其餘交給 AI 處理，並支援多種潤色風格。
智慧擴充：根據上下文提供貼心建議，延伸您的創意與想法。
摘要功能：立即獲取長篇郵件的簡明摘要。
全球溝通：輕鬆將郵件翻譯成任何語言。

此功能支援：

智慧郵件回覆
優化內容
關鍵字草稿
智慧內容擴充
郵件摘要
多語言翻譯

別再等待——立即下載 AI 郵件助理，盡情享受！

最佳 Office 生產力工具

體驗全新 Kutools for Outlook，內含 100+ 項超強功能！立即點擊下載！

🤖KUTOOLS AI：運用先進 AI 技術，輕鬆處理電子郵件——無論是回覆、摘要、優化、擴充、翻譯還是撰寫郵件，通通一鍵搞定！

📧 郵件自動化：自動答覆（支援 POP 與 IMAP）／預約寄送郵件／寄信時依規則自動抄送密送／自動轉發（高級規則）／自動加入問候語／自動將多收件人郵件拆分為個別訊息……

📨 郵件管理：撤回郵件／依主旨等條件封鎖詐騙郵件／刪除重複郵件／高級搜尋／整合文件夾……

📁 附件專業版：批次儲存／批次解除附加／批次壓縮／自動保存／自動拆離／自動壓縮……

👍 一鍵奇蹟：帶附件全部答復／防釣魚郵件／🕘顯示發送者當前時間時區……

👩🏼‍🤝‍👩🏻 聯絡人與行事曆：從選取的郵件中批次新增聯絡人／將聯繫人組拆分為個別群組／移除生日提醒……

用您的慣用語言暢享 Kutools — 完整支援英文、西班牙文、德文、法文、中文等 40 多種語言！

立即一鍵解鎖 Kutools for Outlook！別再等待，馬上下載，全面提升工作效率！

Kutools for Outlook 功能列表立即下載前往購買

🚀 一鍵下載 — 立即取得所有 Office 增益集

強烈推薦：Kutools for Office（5 合 1）

一鍵下載五個安裝程式，一次完成 — Kutools for Excel、Outlook、Word、PowerPoint 與 Office Tab Pro！立即點擊下載！

✅ 一鍵便利：只需一次操作，即可下載全部五個安裝套件！
🚀 隨時應對任何 Office 任務：按需安裝所需增益集，立即提升工作效率！
🧰 包含：Kutools for Excel／Kutools for Outlook／Kutools for Word／Office Tab Pro／Kutools for PowerPoint

關於此套件 ⬇ 下載套件 💳 購買套件