使用vba每周报告统计多个不同文件夹中的电子邮件

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

下面的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

---

谢谢

下面是一个小例子，可以让您开始学习：

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

---

它会检查邮件项目的ReceivedTime字段，如果它比7天新，则会将其计算在内。如果文件夹中有其他项目，则需要进行一些调整。

查看下面的代码。我已经使用了这个网站中提出的解决方案：并对其进行了一些修改，以使项目数量也有所增加。如果子文件夹中有嵌套文件夹，则此子文件夹将调用自身。对我来说很好。我用这样的东西来写我自己的报告

如果取消注释行：“Debug.Print Fold.Name”等，您将获得文件夹和子文件夹的列表。 如果您向“Call ListItems FromLastWeek（Fold）”添加注释，则上周的项目将不被计算在内。相反，您将获得每个文件夹中所有项目的完整报告（如前所述）

---

您好1001001，在LoopFolders子目录中，我收到一个编译错误“属性的无效使用”，突出显示了“Fold.Items.Count”中的.Count。在上面的说明中，您将看到此错误。将以下内容移动到一行：Debug.Print Fold.Name、Fold.Folders.Count、Fold.unreademcount、Fold.Items.Count、Fold.Parent'，Fold.FolderPath，作为Debug.Print表达式的一部分。还要确保最后一个Debug.print在一行中。

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