vba - 按子文件夹和发送月份计算共享邮箱中的电子邮件
问题描述
我想统计每个月共享邮箱/子文件夹中的电子邮件。
此代码仅显示一个文件夹的每个月的计数,并且月份的顺序已出。
如何按月(按正确顺序)和子文件夹显示?
我想要的输出示例:
子文件夹
2019-12 - 电子邮件数量
2020-1 - 电子邮件数量
子文件夹 2
2019-11 - 电子邮件
数量 2019-12 - 电子邮件数量
2020-1 - 电子邮件数量
等等
Sub HowManyEmails()
Dim objOutlook As Object, objnSpace As Object, objFolder As MAPIFolder
Dim EmailCount As Integer
Set objOutlook = CreateObject("Outlook.Application")
Set objnSpace = objOutlook.GetNamespace("MAPI")
On Error Resume Next
Set objFolder = Application.Session.PickFolder
If Err.Number <> 0 Then
Err.Clear
MsgBox "No such folder."
Exit Sub
End If
EmailCount = objFolder.Items.Count
MsgBox "Number of emails in the folder: " & EmailCount, , "email count"
Dim dateStr As String
Dim myItems As Outlook.Items
Dim dict As Object
Dim msg As String
Set dict = CreateObject("Scripting.Dictionary")
Set myItems = objFolder.Items
myItems.SetColumns ("SentOn")
' Determine date of each message:
For Each myItem In myItems
dateStr = GetDate(myItem.SentOn)
If Not dict.Exists(dateStr) Then
dict(dateStr) = 0
End If
dict(dateStr) = CLng(dict(dateStr)) + 1
Next myItem
' Output counts per day:
msg = ""
For Each o In dict.Keys
msg = msg & o & ": " & dict(o) & " items" & vbCrLf
Next
MsgBox msg
Set objFolder = Nothing
Set objnSpace = Nothing
Set objOutlook = Nothing
End Sub
Function GetDate(dt As Date) As String
GetDate = Year(dt) & "-" & Month(dt) & "-"
End Function
解决方案
Option Explicit ' Consider this mandatory
' Tools | Options | Editor tab
' Require Variable Declaration
' If desperate declare as Variant
Private Sub HowManyEmails_With_Subfolders()
Dim objFolder As Folder
Set objFolder = Session.PickFolder
If objFolder Is Nothing Then
Exit Sub
End If
processFolderSorted objFolder
End Sub
Function GetDate(dt As Date) As String
GetDate = Year(dt) & "-" & Month(dt)
End Function
Private Sub processFolderSorted(ByVal objFolder As Folder)
' https://stackoverflow.com/questions/2272361/can-i-iterate-through-all-outlook-emails-in-a-folder-including-sub-folders
Dim EmailCount As Long
Dim dateStr As String
Dim myItem As Object
Dim myItems As items
Dim dict As Object
Dim o
Dim msgCount As String
Dim msg As String
Dim oFolder As Folder
Debug.Print "objFolder: " & objFolder
EmailCount = objFolder.items.count
'Debug.Print "EmailCount: " & EmailCount
If EmailCount > 0 Then
msgCount = "Number of emails in " & objFolder & ": " & EmailCount & vbCr
'Debug.Print msgCount
Set dict = CreateObject("Scripting.Dictionary")
Set myItems = objFolder.items
myItems.Sort "[SentOn]", False
myItems.SetColumns ("SentOn")
' Determine date of each message
For Each myItem In myItems
' Some item types / item classes
' will not have an expected mailitem property
If myItem.Class = olMail Then
dateStr = GetDate(myItem.SentOn)
If Not dict.Exists(dateStr) Then
dict(dateStr) = 0
End If
dict(dateStr) = CLng(dict(dateStr)) + 1
Else
Debug.Print "item bypassed"
End If
Next
' Output counts per day:
For Each o In dict.Keys
msg = msg & o & ": " & dict(o) & " items" & vbCrLf
Next
Debug.Print msgCount & msg
'MsgBox msgCount & msg
Set dict = Nothing
End If
If (objFolder.folders.count > 0) Then
For Each oFolder In objFolder.folders
processFolderSorted oFolder
Next
End If
End Sub
推荐阅读
- python-3.x - 从 odoo 12 中的 res.users 获取用户类型
- html - 如何使用css形状创建具有响应性的平行四边形
- php - 拒绝访问 phpmyadmin
- flutter - 我能找到“flutter pub list”或“flutter pub search”命令行工具吗?
- c# - Console.ReadLine() 来自命令行输入参数
- python - VSCode 笔记本静默显示失败(modify_doc)
- perl - 在 Perl 中读取动态生成的文件行的最佳方法是什么?
- android - 如何在 Android TextView 中准确阅读更多内容?
- django - 在for循环中保存模型时,如何将图像保存在django的媒体文件夹中?
- node.js - Socket.IO:“UnhandledPromiseRejectionWarning:错误:广播时不支持回调”