使用vba对许多不同文件夹中的电子邮件进行计数，以获得每周报告

Question

仍在尝试自动生成报告，其中一部分是每个文件夹中的电子邮件计数。

以下 MSDN 文章适用于一个文件夹，但我有近 100 个文件夹要浏览。

在一周内创建新文件夹并删除旧文件夹。

有没有办法提取文件夹的名称并计算一周内收到的电子邮件？

Sub ShowTotalItemCount() 
Dim nmsName As Outlook.NameSpace 
Dim fldFolder As Outlook.Folder 
Set nmsName = Application.GetNamespace("MAPI") 
Set fldFolder = nmsName.GetDefaultFolder(olFolderInbox) 
fldFolder.ShowItemCount = olShowUnreadItemCount 
End Sub

谢谢！！

Answer 1

看看下面的代码。我使用了本网站中提出的解决方案：http://vbatools.pl/lista-folderow-outlooka/并对其进行了一些更改，以获取项目计数。如果子文件夹中有嵌套文件夹，则此 Sub 调用自身。对我来说效果很好。我在自己的报告中使用这样的 sth。

如果您取消注释行："'调试.打印 Fold.Name"等，您将获得文件夹和子文件夹的列表。 如果您向"呼叫列表项目从上周(折叠("添加评论，则上周的项目将不计算在内。相反，您将获得每个文件夹中所有项目的完整报告(如前所述调试建议(。

Option Explicit
Sub OutlookFolders()
Dim olNamespace As Outlook.Namespace
Dim olFolder As Outlook.Folders
Dim objFolder As Outlook.MAPIFolder
Set olNamespace = Application.GetNamespace("MAPI")
Set olFolder = olNamespace.Folders
For Each objFolder In olFolder
Debug.Print objFolder.Name
Call LoopFolders(objFolder.Folders)    
Next objFolder
Set olNamespace = Nothing
Set olFolder = Nothing
End Sub
Private Sub LoopFolders(Folders As Outlook.Folders)
Dim Fold As Outlook.MAPIFolder
For Each Fold In Folders
' Debug.Print Fold.Name, Fold.Folders.Count, Fold.UnReadItemCount, 
Fold.Items.Count, Fold.Parent ', Fold.FolderPath
Call ListItemsFromLastWeek(Fold)
DoEvents
If Fold.Folders.Count Then LoopFolders Fold.Folders
Next Fold
End Sub
Private Sub ListItemsFromLastWeek(Folder As Outlook.Folder)
Dim item As MailItem
Dim HowManyDays As Integer
Dim counter As Long
HowManyDays = 7
For Each item In Folder.Items
If item.ReceivedTime > Now - HowManyDays Then
counter = counter + 1
End If
Next item
Debug.Print "In folder: " & Folder.Name & "  - there are " & counter & " 
mails received in the past week (it means from " & Now - HowManyDays & " )"
End Sub

Answer 2

这里有一个小例子，可以帮助你入门：

Sub ShowTotalItemCount()
Dim nmsName As Outlook.NameSpace
Dim fldFolder As Outlook.Folder
Dim fldSubFolder As Outlook.Folder
Dim itmMail As MailItem
Dim ItemCount As Long
Set nmsName = Application.GetNamespace("MAPI")
Set fldFolder = nmsName.GetDefaultFolder(olFolderInbox)
For Each fldSubFolder In fldFolder.Folders
ItemCount = 0
Debug.Print fldSubFolder.Name
For Each itmMail In fldSubFolder.Items
If itmMail.ReceivedTime > Now - 7 Then
ItemCount = ItemCount + 1
End If
Next
Debug.Print "  No of mails: " & fldSubFolder.Items.Count
Debug.Print "  No of mails last 7 days: " & ItemCount
Next
End Sub

它检查邮件项目的"接收时间"字段，如果它超过 7 天，则对其进行计数。如果您的文件夹中有其他项目，则需要进行一些调整。