Outlook - 在本月之前发送电子邮件时发出警告

Question

有没有办法设置代码，所以当我从模板发送电子邮件给某人时（通常是我一遍又一遍地与我联系），它会自动检查我是否已在上个月内将其发送给他们。

现在我已经为自己制作了一个警告系统，当我发送电子邮件时会显示一个消息框：

Public Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
    On Error Resume Next
    If InStr(Item.Body, "A string in my template email") Then
        If MsgBox("Have you sent this already this month?", vbYesNo + vbQuestion + vbMsgBoxSetForeground, "Message Text Warning") = vbNo Then
            Cancel = True
        End If
    End If
End Sub

缺点是我手动检查是否已将其发送到特定的接收器。是否有可能以某种方式使它发送它，如果我在上个月没有发送它并警告我，如果我已经在上个月发出它？

Answer 1

您可以在"Sent Items"框中迭代所有已发送的电子邮件，并使用InStr()和DateDiff()函数检查自发送每个内容和日期以来的内容和日期。

Public Sub Application_ItemSend(ByVal thisItem As Object, Cancel As Boolean)

    Dim ns As Outlook.NameSpace
    Dim folder As MAPIFolder
    Dim Item As Object

    Set ns = Session.Application.GetNamespace("MAPI")
    ' set folder to Sent Items box
    Set folder = ns.GetDefaultFolder(olFolderInbox).Parent.Folders("Sent Items")

    ' iterate thru emails
    For Each Item In folder.Items
        ' check subject content & date difference
        If InStr(Item.subject, "your string here") And DateDiff("m", Item.SentOn, Now) < 1 Then
            ' added this part
            If MsgBox("You have already sent this email this month, do you want to send again?", vbYesNo + vbQuestion + vbMsgBoxSetForeground, "Message Text Warning") = vbNo Then
                ' cancel the email
                Cancel = True
            End If
            Exit For      
        End If    
    Next

End Sub

另外，在我的情况下，以下是我在共享收件箱之前完成此操作的方法：

Set olApp = CreateObject("Outlook.Application")
Set olNs = olApp.GetNamespace("MAPI")
Set firstFolder = olNs.Folders("UAT-COE Support Intake Box") ' name of my shared inbox
Set olFolder = firstFolder.Folders("Inbox")

您可能必须执行相同操作，但使用共享的收件箱名称更改"UAT-COE Support..."。还需要用"Inbox"或"Sent Items"更改"Sent"。

将olFolder设置为正确的已发送框后，您可以将其替换为上面代码中的文件夹For each Item in olFolder.Items