Question

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

以下MSDN article适用于一个文件夹，但我有近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

以下是一个可以帮助您入门的小例子：

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天，则会对其进行计数。如果您的文件夹中有其他项目，则需要进行一些调整。

Answer 2

看看下面的代码。我使用过本网站提出的解决方案：http://vbatools.pl/lista-folderow-outlooka/并稍加改动以获得项目数。如果子文件夹中有嵌套文件夹，则此Sub调用自身。对我来说很好。我正在使用这样做我自己的报告。

如果取消注释行：“'Debug.Print Fold.Name，”等，您将获得文件夹和子文件夹的列表。如果您向“Call ListItemsFromLastWeek（Fold）”添加评论，则上周的项目将不计算在内。相反，您将获得每个文件夹中所有项目的完整报告（如前面提到的调试建议）。

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

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

2 个答案: