检查您是否已通过 VBA 回复客户电子邮件

Question

我想检查我的团队是否已回复客户的电子邮件。

Dim O As Outlook.Application
Dim R As Long

Sub project2()
Set O = New Outlook.Application
Dim Omail As Outlook.MailItem
Set Omail = O.CreateItem(olMailItem)
Dim ONS As Outlook.Namespace
Set ONS = O.GetNamespace("MAPI")

Dim FOL As Outlook.Folder
Set FOL = ONS.GetDefaultFolder(olFolderInbox).Folders("MD-GPS")
R = 2
For Each Omail In FOL.Items

    Cells(R, 1) = Omail.Subject
    Cells(R, 2) = Omail.SenderEmailAddress
    
    Call REPLY_STATUS(Omail.Subject, Omail.SenderEmailAddress)
            
    R = R + 1
    On Error Resume Next
Next Omail
End Sub

Sub REPLY_STATUS(MailSubject As String, MailSender As String)

Dim SentEmail As Outlook.MailItem
Set SentEmail = O.CreateItem(olMailItem)

Dim ONS2 As Outlook.Namespace
Set ONS2 = O.GetNamespace("MAPI")

        
Dim FOL2 As Outlook.Folder
Set FOL2 = ONS2.GetDefaultFolder(olFolderSentMail)
Dim check As String
check = "RE: " & MailSubject

For Each SentEmail In FOL2.Items

    If check = SentEmail.Subject And MailSender = SentEmail.Recipients(1).Address Then
        Cells(R, 3) = "Yes"
        Exit For
    Else
    End If
    On Error Resume Next
Next SentEmail

End Sub

1. 在大多数情况下，代码会在 Excel 工作表中捕获发件人电子邮件地址以外的其他内容。
   

2. 由于我们每天收到 500 多封电子邮件，代码变得太慢，因为它会从头开始检查整个文件夹。
   我可以添加一个可以在 Excel 表中提及的开始日期吗？代码将从该日期开始。

3. 如果我的团队已回复这些电子邮件，则代码未填充第 3 列。

4. 代码没有从定义的子文件夹（“MD-GPS”）中提取最新的电子邮件。

注意：为了处理 SMPT 交换帐户错误，我尝试了MailItem.Sender.GetExchangeUser.PrimarySmtpAddress，但如果我将子文件夹更改为其他内容，它就不起作用了。

Answer 1

首先，您不需要创建SentEmail - 摆脱

Set SentEmail = O.CreateItem(olMailItem)

行。

其次，切勿遍历文件夹中的所有项目 - 使用 Items.Find/FindNext 或 Items.Restrict。

第三，您看到的是 EX 类型的地址（与 SMTP 相对）。检查MailItem.Sender.Type 属性 - 如果它是“SMTP”，请使用MailItem.Sender.Address。否则（在“EX”的情况下）使用MailItem.Sender.GetExchangeUser().PrimarySmtpAddress。

话虽如此，您可以检查是否有人回复了原始消息 - 检查 PR_LAST_VERB_EXECUTED MAPI 属性（DASL 名称 http://schemas.microsoft.com/mapi/proptag/0x10810003）是否存在 - 103 是 EXCHIVERB_REPLYTOALLand 102 是 EXCHIVERB_REPLYTOSENDER。如果根本没有设置该属性，则没有理由搜索。

要搜索匹配的主题，请使用类似的查询

"[Subject] = ' & MailSubject  & "'"

请注意，Outlook 对象模型不允许您搜索邮件收件人或附件。如果使用Redemption（我是它的作者）是一个选项，你可以使用类似下面的东西。您可以将 Recipients 指定为搜索字段之一，Redemption 将创建对收件人姓名/地址/SMTP 地址的限制

set session = CreateObject("Redemption.RDOSession")
session.MAPIOBJECT = O.Session.MAPIOBJECT
set SentEmail = FOL2.Items.Find("""http://schemas.microsoft.com/mapi/proptag/0x0E1D001F"" = '" & MailSubject & "' AND Recipients = '" & MailSender & "'")

请注意，大多数 MAPI 商店不会搜索 PR_SUBJECT，只会搜索 PR_NORMALIZED_SUBJECT（这是没有 RE: 或 FW: 前缀的主题） - 这是上面的 sn-p 使用的。