Question

我们有一个共享邮箱，并且Alerts文件夹充满了警报。成千上万的-大多数是从一天的开始到一天的结束。实际上，我们可能需要在一天当中出现新的警报。

没人会在早上将文件夹批量标记为已读，因为它花费的时间太长-您无法突出显示who邮箱并单击“标记为未读”。标记电子邮件的一种方法是一次突出显示几百个-手动操作会花费一些时间。

我制作了这个脚本，因为它会自动标记“ alerts”文件夹中的电子邮件。但是，它似乎同时处理了整个文件夹。该脚本等效于Highlightimg整个文件夹，并标记了一个批量删除，这需要很长时间，并且会锁定共享电子邮件框。我想要从文件夹底部开始的内容，循环浏览每封电子邮件，如果未读，请将电子邮件标记为未读，请暂停一秒钟，然后下一个。

有可能吗？

Sub Test2()


Dim objInbox As Outlook.MAPIFolder
Dim objOutlook As Object, objnSpace As Object, objMessage As Object
Dim objSubfolder As Outlook.MAPIFolder

Set objOutlook = CreateObject("Outlook.Application")
Set objnSpace = objOutlook.GetNamespace("MAPI")
Set objInbox = objnSpace.GetDefaultFolder(olFolderInbox)
Set objSubfolder = objInbox.Folders.Item("_ALERTS")

For Each objMessage In objSubfolder.Items
objMessage.UnRead = False
Next

Set objOutlook = Nothing
Set objnSpace = Nothing
Set objInbox = Nothing
Set objSubfolder = Nothing


End Sub

Answer 1

您可以在Outlook中创建一个代码，当在目标文件夹中输入新电子邮件时，该代码会触发。

Public WithEvents objMails As Outlook.Items
Private Sub Application_Startup()
Set objMails = Outlook.Application.Session.GetDefaultFolder(olFolderInbox).Folders("_ALERTS").Items
End Sub
Private Sub objMails_ItemAdd(ByVal Item As Object)    
'Do more stuff
End Sub

这将避免一次遍历所有电子邮件

Answer 2

您可以使用“限制”来限制要处理的项目。

Option Explicit

Sub Test2()

Dim objInbox As Folder
Dim objnSpace As namespace

Dim objSubfolder As Folder

dim unreadItems As items
dim unreaditemsCount as long

Set objnSpace = GetNamespace("MAPI")
Set objInbox = objnSpace.GetDefaultFolder(olFolderInbox)
Set objSubfolder = objInbox.Folders.Item("_ALERTS")

set unreadItems = objSubfolder.Items.Restrict("[UnRead] = True")

unreaditemsCount = unreadItems.Count

If unreaditemsCount > 0 Then

    ' Reverse loop when changing the number of items in the collection
    For i = unreaditemsCount to 1 
        unreadItems(i).UnRead = False
    Next

end if

Set objInbox = Nothing
Set objnSpace = Nothing

Set objSubfolder = Nothing
Set unreadItems = Nothing

End Sub

oultlook vba遍历收件箱，而不是批量扫描

2 个答案: