在VBA中按名称分配前景类别

Question

此脚本按Outlook发件人名称选择。我使用以下内容从两个名称中提取电子邮件，并将类别alarm_one分配给邮箱中的所有内容。但是，它的工作非常非常缓慢。喜欢摆放它，然后去喝咖啡，在某人的桌子前停下来聊天，然后他们慢慢回来。 有什么方法可以改善吗？

 Sub alertItems()
    Dim myNameSpace As Outlook.NameSpace
    Dim myInbox As Outlook.Folder
    Dim myDestFolder As Outlook.Folder
    Dim myItems As Outlook.Items
    Dim myItem As Object

    Set myNameSpace = Application.GetNamespace("MAPI")
    Set myInbox = myNameSpace.GetDefaultFolder(olFolderInbox)
    Set myItems = myInbox.Items
    Set myDestFolder = myInbox.Folders("test")
    Dim varSearchTerm As Variant: For Each varSearchTerm In Array("ServerFARM_SOD", "TPS_Report"     )
Set myItem = myItems.Find("[SenderName] = '" & varSearchTerm & "'")
    While TypeName(myItem) <> "Nothing"
        myItem.Categories = "alarm_one" 
        myItem.Save
    Wend
Next
End Sub