My review: Amazon Kindle Fire 7'' 5th generation ►

◄ Shaving products I would recommend

This is about the simplest code possible: there's no error handling if the user cancels out of the folder selection dialogue, for instance, but it works. It's a mix of the approaches in this and this post, with a tangent via this one.

Sub MarkAllRead()
	Dim MyFolder As Outlook.Folder
	Set MyFolder = Application.GetNamespace("MAPI").PickFolder
	DoAnything MyFolder
	LoopFolders MyFolder.Folders, True
End Sub
 
Public Sub LoopFolders(Folders As Outlook.Folders, ByVal Recursive As Boolean)
	Dim Folder As Outlook.MAPIFolder
	For Each Folder In Folders
		DoAnything Folder
		If Recursive Then
			LoopFolders Folder.Folders, Recursive
		End If
	Next
End Sub

Public Sub DoAnything(Folder As Outlook.MAPIFolder)
	Dim Item As Object
	' avoid using For Each because Outlook will renumber whilst loop is still running
	For i = Folder.Items.Restrict("[UnRead]=True").Count To 1 Step -1
		Set Item = Folder.Items.Restrict("[UnRead]=True")(i)
		If Item.UnRead = True Then
			' Debug.Print UCase(Folder.Name) & " -- " & TypeName(Item) & _
			' " -- " & Item.Subject
			Item.UnRead = False
			Item.Save
		End If
	Next
End Sub

BLOG  MORE  ABOUT  MAIL