Macro stops running after MsgBox - Outlook Lock Up

[PrizeGotti]

Hi all,

I recently found a macro written by a member here (showthread.php?68186-Outlook-VBA-Macro-fo-Loop-through-outlook-unread-emails) which I have tried to adapt for my own use.

The macro looks for unread emails that match certain conditions and moves them to another folder.

When running the macro, I get the msgbox to appear showing the unread count, but at that point it stops and my entire Outlook session just freezes. I suspect it is the following line;

For lngCount = myInbox.Items.Count To 1 Step -1
As I assume "myInbox.Items.Count" is my total count of items in my email, which is over 80,000 items.

Is there any so it just checks the unread emails instead of all 80,000?

Full Code:


Public Sub TankerScans()
'Original Code - Graham Mayor - Last updated - 22 Dec 2020
Dim myNameSpace As Outlook.NameSpace
Dim myInbox As Outlook.Folder
Dim myItem As MailItem
Dim myDestFolder As Outlook.Folder
Dim lngCount As Long
Set myNameSpace = Application.GetNamespace("MAPI")
Set myInbox = myNameSpace.GetDefaultFolder(olFolderInbox)
Set myDestFolder = myInbox.Folders("TankerScans")
MsgBox myInbox.UnReadItemCount
If myInbox.UnReadItemCount > 0 Then
For lngCount = myInbox.Items.Count To 1 Step -1
If TypeName(myInbox.Items(lngCount)) = "MailItem" Then
If myInbox.Items(lngCount).UnRead = True Then
Set myItem = myInbox.Items(lngCount)
If myItem.SenderEmailAddress = "emailaddress" Then
myItem.Move myDestFolder
myItem.UnRead = False
End If
End If
End If
DoEvents
Next lngCount
End If
Set myNameSpace = Nothing
Set myInbox = Nothing
Set myItem = Nothing
Set myDestFolder = Nothing
End Sub



Many thanks!

[rollis13]

Well, your macro is already doing that with:
If myInbox.Items(lngCount).UnRead = True ThenIt tests if the email is unread (=True) Then .Moves it, if not it continues to cycle through your folder, no other way.

[Paul_Hossler]

Maybe add


application.statusbar = lngCount

after the.UnRead = True line