如何从已发送的电子邮件中分配、更改和删除类别（VBA Outlook）

Question

我正在尝试在 VBA 中编写一个宏。我发送了很多电子邮件，但没有得到任何回复。因此，我需要跟踪这一点，以便在适当的时间后发送后续电子邮件。 （如果没有 Outlook 中的宏，就没有成熟的方法可以做到这一点，我觉得这很疯狂）。

**所以..为了解决这个问题，我想要一个执行以下操作的宏：

1. 在发送电子邮件之前，我设置了一个带有后续标志的提醒。这样，我可以选择自定义时间来跟进这封特定的电子邮件。
2. 如果发送的电子邮件标有后续标志，它也会自动标有“蓝色”类别
3. 如果我在设置的计时器用完之前收到回复，则任务被清除，蓝色类别被清除。
4. 如果在计时器用完之前我没有收到回复，类别会变为红色，并且我会收到来自 Outlook 的通知提醒。**

这样我可以将我的“已发送”文件夹分类到两个类别中，以查看需要跟进的电子邮件。此外，每当人们没有及时回复时，我都会收到提醒。

如果我在设定的时间内收到回复，以下代码将清除后续标志。 但是，如果我在计时器之前收到回复，我不知道如何为已发送的项目分配一个类别并清除它。我是 VBA 的菜鸟，因此感谢您提供任何帮助。

Public WithEvents objInboxItems As Outlook.Items

Private Sub Application_Startup()
    Set objInboxItems = Application.Session.GetDefaultFolder(olFolderInbox).Items
End Sub

'If receive the reply, clear the flag and remove the reminder
Private Sub objInboxItems_ItemAdd(ByVal Item As Object)
    Dim objSentItems As Outlook.Items
    Dim objVariant As Variant
    Dim i As Long
    Dim strSubject As String
    Dim dSendTime As String
 
    Set objSentItems = Outlook.Application.Session.GetDefaultFolder(olFolderSentMail).Items
 
    If Item.Class = olMail Then
       For i = 1 To objSentItems.Count
           If objSentItems.Item(i).Class = olMail Then
              Set objVariant = objSentItems.Item(i)
              strSubject = LCase(objVariant.Subject)
              dSendTime = objVariant.SentOn
 
              If LCase(Item.Subject) = "re: " & strSubject Or InStr(LCase(Item.Subject), strSubject) > 0 Then
                 If Item.SentOn > dSendTime Then
                    With objVariant
                         .ClearTaskFlag
                         .ReminderSet = False
                         .Save
                    End With
                    
                 End If
              End If
           End If
       Next i
    End If
End Sub

Answer 1

这是我前段时间使用的一个类。也许你可以抓住一些想法

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "ThisOutlookSession"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Option Explicit
'Categorize Sent Items
'Place in ThisOutlookSession
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
On Error Resume Next

Dim insp As Outlook.Inspector
Dim stringCatReference() As Variant


stringCatReference = Array("CAM-", "CGI-", "COS-", "CON-", "HEXA-", "ITH-", "KALL-")

    If TypeOf Application.ActiveWindow Is Outlook.Inspector Then
        Set insp = Application.ActiveWindow
    End If
    
    If insp Is Nothing Then
        Dim inline As Object
        Set inline = Application.ActiveExplorer.ActiveInlineResponse
        If inline Is Nothing Then Exit Sub
    Else
       Set insp = Application.ActiveInspector
       If insp.CurrentItem.Class = olMail Then
          
       Else
         Exit Sub
       End If

    End If
    
    If TypeOf Item Is Outlook.MailItem And IsInArray(Item.Subject, stringCatReference) = 0 Then
        Set Item = Application.ActiveInspector.CurrentItem
        Item.ShowCategoriesDialog
        Item.Save
    End If
End Sub

Function IsInArray(stringToBeFound As String, arr As Variant) As Boolean
    
    Dim xInt As Integer
    
    For xInt = 0 To UBound(arr)
    
        IsInArray = InStr(stringToBeFound, arr(xInt)) > 0
        
        If IsInArray = True Then Exit For
        
    Next xInt

End Function