Outlook Macro - Mark folder items as read.

Sub Test1()
Application.ScreenUpdating = False

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

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

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

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

Application.ScreenUpdating = True
End Sub

Sub Test2()
Application.ScreenUpdating = False

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("Test")

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

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

Application.ScreenUpdating = True
End Sub

Sub MarkAllRead()

Dim ResultFolder As Folder
Dim Folder As Folder
Dim item As MailItem
Dim BaseFolder As Outlook.MAPIFolder
Dim WalkResult As Long

Set BaseFolder = Application.GetNamespace("MAPI").PickFolder
Set ResultFolder = GetFolder(BaseFolder.FolderPath)

For Each Folder In ResultFolder.Folders
WalkResult = GetNextLevel(ResultFolder.FolderPath)

For Each item In Folder.Items.Restrict("[unread] = true")
item.UnRead = False
Next
Next
Set ResultFolder = Nothing
Set Folder = Nothing
Set item = Nothing
End Sub

Function GetNextLevel(strFolderPath As String) As Long

Dim WalkResultFolder As Folder
Dim Folder As Folder
Dim item As MailItem
Dim WalkResult As Long
Set WalkResultFolder = GetFolder(strFolderPath)
For Each Folder In WalkResultFolder.Folders

WalkResult = GetNextLevel(Folder.FolderPath)

For Each item In Folder.Items.Restrict("[unread] = true")
item.UnRead = False
Next
Next
Set ResultFolder = Nothing
Set Folder = Nothing
Set item = Nothing
End Function

Function GetFolder(strFolderPath As String) As MAPIFolder

Dim colFolders As Outlook.Folders
Dim objFolder As Outlook.MAPIFolder
Dim arrFolders() As String
Dim i As Long
On Error Resume Next

strFolderPath = Replace(strFolderPath, "\\", "")

strFolderPath = Replace(strFolderPath, "/", "\")

arrFolders() = Split(strFolderPath, "\")

Set objFolder = Application.GetNamespace("MAPI").Folders.item(arrFolders(0))
If Not objFolder Is Nothing Then
For i = 1 To UBound(arrFolders)
Set colFolders = objFolder.Folders
Set objFolder = Nothing
Set objFolder = colFolders.item(arrFolders(i))

If objFolder Is Nothing Then
Exit For
End If
Next
End If
Set GetFolder = objFolder
Set colFolders = Nothing
End Function