Nếu bạn lưu trữ các email đã gửi trong một số thư mục và bây giờ muốn đếm tất cả các thư đã gửi này theo tháng, bạn có thể đọc bài viết này. Ở đây chúng tôi sẽ giới thiệu một cách nhanh chóng đáng kể để có được nó.
Bài báo trước – “Cách đếm nhanh email đến theo ngày, tháng hoặc năm qua Outlook VBA” đã chia sẻ cách đếm email theo tháng. Tuy nhiên, nó có thể xử lý các email trong một thư mục. Nếu bạn muốn đếm email trong một số hoặc thậm chí tất cả các thư mục thư, bạn nên sử dụng các phương tiện khác. Vì vậy, trong phần tiếp theo, chúng tôi sẽ giới thiệu cho bạn một cách khác nhanh hơn nhiều.
Đếm số email đã gửi theo tháng
- Để bắt đầu, hãy truy cập trình soạn thảo Outlook VBA thông qua “Alt + F11”.
- Sau đó, kích hoạt tham chiếu đến “MS Excel Object Library” theo “Cách thêm một đối tượng Library Tham khảo trong VBA".
- Sau đó, đặt mã VBA sau vào dự án hoặc mô-đun.
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
- Tiếp theo, di chuyển con trỏ vào chương trình con đầu tiên.
- Sau đó nhấn “F5” để kích hoạt macro này.
- Ngay lập tức, một tệp Excel sẽ hiển thị, trong đó chứa số lượng email đã gửi hàng tháng, như thể hiện trong hình bên dưới.
Đừng hoảng sợ khi đối mặt với sự tham nhũng của Outlook
Bạn có thể có xu hướng lo lắng khi gặp phải hư hỏng PST. Tuy nhiên, trên thực tế, tốt nhất bạn nên bình tĩnh lại càng sớm càng tốt. Như chúng ta đều biết, hoảng loạn là điều bất lực, thậm chí còn dẫn đến những vấn đề hỗn loạn và nghiêm trọng hơn. Bạn nên giữ bình tĩnh để cân nhắc biện pháp, chẳng hạn như suy nghĩ xem mình đã cập nhật bản sao lưu chưa và cân nhắc cách thực hiện. sửa chữa PST – có nên sử dụng công cụ của bên thứ ba như DataNumen Outlook Repair hoặc liên hệ với các chuyên gia có liên quan.
Giới thiệu tác giả:
Shirley Zhang là một chuyên gia phục hồi dữ liệu trong DataNumen, Inc., công ty hàng đầu thế giới về công nghệ khôi phục dữ liệu, bao gồm sửa chữa mdf và các sản phẩm phần mềm sửa chữa triển vọng. Để biết thêm thông tin, hãy truy cập www.datanumennăm