vba - 在 Outlook 中使用 VBA 收集收到的电子邮件的统计信息

Question

在工作中，我们使用共享的 Outlook 邮箱接收来自用户的电子邮件，目前我们有轮到谁来监视邮箱和回复等。我们的工作时间是从我们开始使用电子邮件地址开始的早上 7 点到下午 5 点.

在接下来的 2 个月中，我们将跟踪一个小时数的变化，我们(或者我应该说，只有我自己)将监控邮箱直到晚上 11 点。

我想要做的是收集一些关于我们收到的电子邮件的统计数据，看看从业务角度来看是否值得在跟踪之后继续轮类。

我想做的是使用一些 VBA 来检查收件箱中的电子邮件，然后将数据分解为一些统计数据以进行管理，例如:

Monday 06/05/12: 
49 emails received, 34 were replies, 15 were new
At 7am received: 0 emails
At 8am received: 1 emails
------
At 11pm received: 0 emails

等

要确定电子邮件是原始邮件还是回复邮件，我认为最容易查看主题是否以 RE:? (我知道这不是万无一失的，但我认为它适用于基本统计数据)

有没有人做过这样的事情？有没有简单/正确的方法来做到这一点？

有人有任何有用的提示/代码示例吗？

Answer 1

你可以从这样的事情开始

Sub EmailStats()

    Dim olMail As MailItem
    Dim aOutput() As Variant
    Dim lCnt As Long
    Dim xlApp As Excel.Application
    Dim xlSh As Excel.Worksheet
    Dim flInbox As Folder

    Set flInbox = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)

    ReDim aOutput(1 To flInbox.Items.Count, 1 To 4)

    For Each olMail In flInbox.Items
        If TypeName(olMail) = "MailItem" Then
            lCnt = lCnt + 1
            aOutput(lCnt, 1) = olMail.SenderEmailAddress 'maybe stats on domain
            aOutput(lCnt, 2) = olMail.ReceivedTime 'stats on when received
            aOutput(lCnt, 3) = olMail.ConversationTopic 'group based on subject w/o regard to prefix
            aOutput(lCnt, 4) = olMail.Subject 'to split out prefix
        End If
    Next olMail

    Set xlApp = New Excel.Application
    Set xlSh = xlApp.Workbooks.Add.Sheets(1)

    xlSh.Range("A1").Resize(UBound(aOutput, 1), UBound(aOutput, 2)).Value = aOutput
    xlApp.Visible = True

End Sub

如果要添加更多数据，只需更改 Redim语句以容纳更多列并将它们添加到 If 块中。一旦在 Excel 中(或者可能是 Access 或 SQLServer，如果它有很多数据)，你可以添加一些计算，比如

=IF(LEFT(@Subject,3)="RE:","Reply",IF(LEFT(@Subject,3)="FW:","Forward","Original"))

然后像疯了一样旋转。

您需要引用 Excel 对象库才能使上述代码正常工作。