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 block 中。一旦进入 Excel(如果数据量很大，也可能是 Access 或 SQLServer)，您可以添加一些计算，例如

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

然后疯狂地旋转。

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