根据约会突出显示Outlook中的邮件

如果收到的邮件是在日历中的某个约会期间收到的，我想强调一下。 更准确地说：我们团队中的每个人都负责每周提供支持。我使用Outlook日历了解我何时负责支持。现在，我想高亮显示收到的支持邮件，如果它们在本次支持约会期间到达

---

我怀疑使用规则或条件格式是否可能做到这一点。但是：我说得对吗？如果我是对的，也许有一个插件？或者如果没有，你能给我一个kickstart我怎么能写这样一个钩子？

你可以在“收件箱”文件夹上创建一个规则

首先，你应该用颜色编码使重要的电子邮件在Outlook中脱颖而出

您可以参考此链接：

选择“条件…”时，应选择“高级”

点击现场->常用->重要性，“重要性”选择低。单击添加到列表，单击“确定”

其次，您可以创建一个规则

单击规则->创建规则，选择“高级选项”

选择在特定数据范围内接收，然后选择支持的时间段

选择“使其成为重要”。由高变低

最后，选择“运行此规则…”和“打开此规则”，单击“完成”

---

老实说，如果我目前不负责支持，我没有测试以下代码是否有效。我将在周一检查：）并且

isSupportDay

函数仍然需要一些重构

Option Explicit    

Private WithEvents inboxItems As Outlook.Items    
Private isTodaySupport As Boolean    

Private Sub Application_Startup()    
    isTodaySupport = isSupportDay()    

    Dim outlookApp As Outlook.Application    
    Dim objectNS As Outlook.NameSpace    

    Set outlookApp = Outlook.Application    
    Set objectNS = outlookApp.GetNamespace("MAPI")    
    Set inboxItems = objectNS.GetDefaultFolder(olFolderInbox).Items    
End Sub    

Private Sub inboxItems_ItemAdd(ByVal Item As Object)    
    On Error GoTo ErrorHandler    

    If TypeName(Item) = "MailItem" And isTodaySupport And isSupportMail(Item) Then    
        Item.Importance = OlImportance.olImportanceHigh    
        'Item.MarkAsTask (OlMarkInterval.olMarkToday)    
        Item.Save    
    End If    

    ExitNewItem:    
        Exit Sub    

    ErrorHandler:    
        MsgBox Err.Number & " - " & Err.Description    
        Resume ExitNewItem    
End Sub    

Function isSupportDay() As Boolean    
    Dim myStart As Date    
    Dim myEnd As Date    
    Dim oCalendar As Outlook.Folder    
    Dim oItems As Outlook.Items    
    Dim oItemsInDateRange As Outlook.Items    
    Dim oFinalItems As Outlook.Items    
    Dim oAppt As Outlook.AppointmentItem    
    Dim strRestriction As String    

    myStart = Date    
    myEnd = DateAdd("h", 1, myStart)    

    'Construct filter    
    strRestriction = "[Start] >= '" & _    
        Format$(myStart, "mm/dd/yyyy hh:mm AMPM") _    
        & "' AND [End] <= '" & _    
        Format$(myEnd, "mm/dd/yyyy hh:mm AMPM") & "'"    

    Set oCalendar = Application.Session.GetDefaultFolder(olFolderCalendar)    
    Set oItems = oCalendar.Items    
    oItems.IncludeRecurrences = True    
    oItems.Sort "[Start]"    

    'Restrict the Items collection for the date range    
    Set oItemsInDateRange = oItems.Restrict(strRestriction)    

    'Construct filter for Subject containing 'team'    
    Const PropTag  As String = "https://schemas.microsoft.com/mapi/proptag/"    
    strRestriction = "@SQL=" & Chr(34) & PropTag _    
        & "0x0037001E" & Chr(34) & " = 'Support'"    

    'Restrict the last set of filtered items for the subject    
    Set oFinalItems = oItemsInDateRange.Restrict(strRestriction)    

    isSupportDay = oFinalItems.Count > 0    
End Function    

Function isSupportMail(Item As Outlook.mailItem) As Boolean    
    isSupportMail = Item.Subject Like "Support - (*"    
End Function    

选项显式
Private，邮件中的事件作为Outlook.Items
作为布尔值的私有支持
私有子应用程序_启动（）
isTodaySupport=isSupportDay（）
Dim outlookApp作为Outlook.Application
将objectNS设置为Outlook.NameSpace
设置outlookApp=Outlook.Application
Set objectNS=outlookApp.GetNamespace（“MAPI”）
设置inboxItems=objectNS.GetDefaultFolder（olFolderInbox）.Items
端接头
私有子inboxItems_ItemAdd（ByVal项作为对象）
关于错误转到错误处理程序
如果TypeName（Item）=“MailItem”且isTodaySupport和isSupportMail（Item），则
Item.Importance=OlImportance.olImportanceHigh
'Item.MarkAsTask（OlMarkInterval.olMarkToday）
项目。保存
如果结束
现有项目：
出口接头
错误处理程序：
MsgBox错误编号&“-”&错误说明
恢复现有项目
端接头
函数isSupportDay（）为布尔值
将myStart设置为日期
把我的名字改成日期
将oCalendar设置为Outlook.Folder
将oItems设置为Outlook.Items
Dim oItemsInDateRange作为Outlook.Items
作为Outlook.Items的项目的名称
Dim oAppt作为Outlook.AppointmentItem
作为字符串的Dim strRestriction
myStart=日期
myEnd=DateAdd（“h”，1，myStart）
'构造过滤器
strRestriction=“[Start]>=””和
格式$（myStart，“mm/dd/yyyy hh:mm AMPM”）\
&"及(完)感谢您的努力！我真正感兴趣的问题是：如何使日期动态化？我已经在日历中输入了支持时间，我不想为我负责支持的每个星期创建一个规则。是的，它会起作用。但是让规则使用日历会很好。您可以创建一个宏规则，使用vba获取日历p建议。然后使用vba将“收件箱”文件夹电子邮件设置为高度重要。您可以参考以下链接：我似乎无法在Outlook 365/2016中使用宏规则（没有尝试，但我读到这是不可能的）。因此，我开始编写一个宏，对每个传入邮件执行。我偶然发现了80/20规则，80%的宏非常简单。我在默认收件箱文件夹的项目上有一个
with events
变量。还有一个侦听器
inboxItems_ItemAdd
。最后20%是设置邮件的重要性：
Item.importance=OlIImportance.olImportanceHigh
不会更改“我的收件箱”中邮件项目的任何内容。用MsgBox语句替换此行将显示MsgBox。您可以使用此代码“Dim Filter As String Filter=“[Importance]=2”将项目作为Outlook进行Dim Items。项目集项目=收件箱。项目。限制（筛选）“，请参阅此链接：这将为我提供具有高度重要性的邮件。我想做的是将收件箱中收到的邮件的重要性设置为高。但是
item.Importance=oliimportancehigh
不会更改收件箱中相应邮件的重要性/优先级。