如何使用Excel VBA根据标准统计Outlook中所有文件夹和子文件夹中的电子邮件？

我必须在每周报告的特定标准内计算收到的邮件数量。邮件位于Outlook的各个文件夹和子文件夹中

Dim objOutlook As Object, objnSpace As Object, objFolder As Outlook.MAPIFolder
Dim EmailCount As Integer

Sub HowManyDatedEmails()
    Set objOutlook = CreateObject("Outlook.Application")
    Set objnSpace = objOutlook.GetNamespace("MAPI")

    On Error Resume Next
    Set objFolder = objnSpace.GetDefaultFolder(olFolderInbox)
    If Err.Number <> 0 Then
        Err.Clear
        MsgBox "No such folder."
        Exit Sub
    End If

    Dim iCount As Integer, DateCount1 As Integer
    Dim myDate1 As Date
    Dim myDate2 As Date
    Dim DateCount2 As Integer

    EmailCount = objFolder.Items.Count
    DateCount1 = 0
    DateCount2 = 0
    myDate1 = Sheets("Sheet1").Range("A1").Value
    myDate2 = Sheets("Sheet1").Range("B1").Value

    For iCount = 1 To EmailCount
        With objFolder.Items(iCount)

            If DateSerial(Year(.ReceivedTime), Month(.ReceivedTime), Day(.ReceivedTime)) >= myDate1 And _
              DateSerial(Year(.ReceivedTime), Month(.ReceivedTime), Day(.ReceivedTime)) <= myDate2 And _
              .SenderEmailAddress Like "*kailash*" Then

                DateCount1 = DateCount1 + 1
            End If

            If DateSerial(Year(.ReceivedTime), Month(.ReceivedTime), Day(.ReceivedTime)) >= myDate1 And _
              DateSerial(Year(.ReceivedTime), Month(.ReceivedTime), Day(.ReceivedTime)) <= myDate2 And _
              .SenderEmailAddress Like "*soumendra*" Then

                DateCount2 = DateCount2 + 1
            End If

         End With
     Next iCount

    Set objFolder = Nothing
    Set objnSpace = Nothing
    Set objOutlook = Nothing
    Sheets("Sheet1").Range("B2").Value = DateCount1
    Sheets("Sheet1").Range("B3").Value = DateCount2

End Sub

我需要Excel VBA代码，以便工作表列表根据标准编号显示计数数字

---

我可以对一个文件夹执行此操作，但我希望对收件箱中的所有文件夹和子文件夹递归执行此操作。

正如我在评论中所说，这是一个Outlook宏。如有必要，我可以向您演示如何将其转换为Excel宏。如果你需要更多的帮助，你必须扩大你的问题

Sub ListStoresAndAllFolders()

  ' Displays the name of every accessible store
  ' Under each store, displays an indented list of all its folders

  ' Technique for locating desktop from answer by Kyle:
  ' http://stackoverflow.com/a/17551579/973283

  ' Needs reference to Microsoft Scripting Runtime if "TextStream"
  ' and "FileSystemObject" are to be recognised

  Dim FileOut As TextStream
  Dim FldrCrnt As Folder
  Dim Fso As FileSystemObject
  Dim InxFldrChild As Long
  Dim InxStoreCrnt As Long
  Dim Path As String
  Dim StoreCrnt As Folder

  Path = CreateObject("WScript.Shell").specialfolders("Desktop")

  Set Fso = CreateObject("Scripting.FileSystemObject")
  Set FileOut = Fso.CreateTextFile(Path & "\ListStoresAndAllFolders.txt", True)

  With Application.Session
    For InxStoreCrnt = 1 To .Folders.Count
      Set StoreCrnt = .Folders(InxStoreCrnt)
      With StoreCrnt
        FileOut.WriteLine .Name
        For InxFldrChild = .Folders.Count To 1 Step -1
          Set FldrCrnt = .Folders(InxFldrChild)
          Call ListAllFolders(FldrCrnt, 1, FileOut)
        Next
      End With
    Next
  End With

  FileOut.Close

End Sub
Sub ListAllFolders(ByRef Fldr As Folder, ByVal Level As Long, ByRef FileOut As TextStream)

  ' This routine:
  '  1. Output name of Fldr
  '  2. Calls itself for each child of Fldr
  ' It is designed to be called by ListStoresAndAllFolders()

  Dim InxFldrChild As Long

  With Fldr
    FileOut.WriteLine Space(Level * 2) & .Name
    For InxFldrChild = .Folders.Count To 1 Step -1
      Call ListAllFolders(.Folders(InxFldrChild), Level + 1, FileOut)
    Next
  End With

End Sub

---

欢迎来到SO。请看，别忘了阅读和阅读。另外，请查看，我知道没有标准的Outlook功能可以按您搜索的方式计算电子邮件数量。有一些附加软件包提供此功能，这证实了我的信念，即它不是标准的。使用VBA，扫描每个商店中的每个文件夹以查找电子邮件并不特别困难。如果您心中有一组特定的搜索条件，那么编写一个例程来计算与这些条件的匹配项不会增加太多额外的难度。但是，允许用户输入不同标准的界面将更具挑战性。在任何人提供任何帮助或建议之前，您需要详细说明您的要求。请查看@TonyDallimore，我希望现在它更清楚。谢谢！我已根据具体要求更新了我的问题。你能帮我制定excel vba的代码吗。