Làm cách nào để đếm số lượng email đã gửi mỗi tháng trong Outlook?

Đôi khi, bạn có thể muốn biết mình đã gửi bao nhiêu email mỗi tháng. Hướng dẫn này sẽ giới thiệu mã VBA để bạn đếm số lượng email đã gửi mỗi tháng trong Outlook.

Đếm số lượng email đã gửi mỗi tháng trong Outlook với mã VBA

Vui lòng áp dụng mã VBA dưới đây để nhận được số lượng email đã gửi mỗi tháng như hình bên dưới:

1. Giữ ALT + F11 phím để mở Microsoft Visual Basic cho các ứng dụng cửa sổ.

2. Nhấp chuột Chèn > Mô-đunvà dán mã sau vào Mô-đun Cửa sổ.

Mã VBA: Đếm số lượng email đã gửi mỗi tháng:

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$("") 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

Chú thích: Trong mã, vui lòng thay đổi tài khoản email “”Của riêng bạn.

3. Vẫn trong Microsoft Visual Basic cho các ứng dụng cửa sổ, nhấp CÔNG CỤ > dự án, Trong Tài liệu tham khảo-Dự án hộp thoại, kiểm tra Thư viện đối tượng Microsoft Excel 16.0 tùy chọn từ Tài liệu tham khảo có sẵn hộp danh sách, xem ảnh chụp màn hình:

4. Sau đó nhấn vào OK để đóng hộp thoại và nhấn F5 phím để chạy mã này. Sau đó, một tệp Excel sẽ mở ra, hiển thị số lượng email đã gửi của mỗi tháng cho tài khoản cụ thể, xem ảnh chụp màn hình: