oultlook vba loop over inbox, not bulk scan - vba

Question

We have a shared mailbox, and the alerts folder gets filled with alerts. Thousands of them - most from start of day and end of day. New alerts in the middle of the day might actually be something that we need look at.
Noone ever bulk marks the folder as read in the morning, because it takes too long - you can't highlight the who mailbox and click "mark as unread". The onely way to mark the emails is by highlighting a few hundred at a time - which takes along time manually.
I made thsi script because it will automagically mark the emails in the "alerts' folder. However, it seems to go after the whole folder at the same time. The script ist eh equivalent of highlightimg the whole folder, and marking a bulk delete. It takes to long and locks up the shared email box. I would like something that would start at the bottom of the folder, cycle through each email, and if unread, mark the email unread. pause for a second, then the next one.
Is that possible?
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

You can create a code in Outlook which get triggers when new Email entered in a target folder.
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
which will avoid looping through all the emails at a time

Answer 2

You could use Restrict to limit the items to be processed.
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