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