Outlook Macro - Mark folder items as read.

[Airn5475]

Hello,
I am new to macros, vba and outlook and I guess I just need help getting started. I have a simple request and was wondering if someone could explain a few of the steps.
I would like to create a macro that simply goes to a folder and marks everything as read. Nothing serious, but it's something I do often. I do have rules set up in outlook already, but this is a little different reasoning.

Thank you,
Aaron

 

[grich962]

it isn't a macro but the way I do it is Right click on the folder that has the unread messages and click "Mark all as read"

 

[Tom Urtis]

simply goes to a folder and marks everything as read.

Example using the Inbox as the folder of interest to mark all items as read, tested no problem for me using Office XP:

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

 

[Airn5475]

Thanks for your reply.
Now how do I mark the items that are inside of a folder, that is inside of my inbox, as read?
Thanks,

 

[Tom Urtis]

Example using "Test" as the name of the Inbox subfolder; modify for actual subfolder name.

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

 

[Airn5475]

Thanks Tom that seemed to work.
I had to comment out the "Application.ScreenUpdating..." lines, but after that it runs fine.
Thanks again!

Does anyone any good websites on creating custom forms in outlook? I need help on the controls coding.

 

[Stonywall]

Here is a script that will traverse the folder and sub folders you choose. It will prompt for the root folder when run.
Tested in Outlook 2003, 2007 and 2010.

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

 

[seiun]

Hi
I've got similar problem. My superior reads e-mails in shared mailbox.
He is angy he have to unmark itemas as read after he open and read e-mail. Setup outlook to disable this function can not be used.

How to write VBA script which block "marking items as read" when user open and read e-mails. I could be attached to button. When user click this button, script will be active and outlook can not change e-mail status as "readed".
I hope you help me solve this issue.

Kind Regards in advance.
Tomasz.

Cross-posted here: http://www.mrexcel.com/forum/showthread.php?t=639612

 

[StuLux]

This code looks really useful for something I am trying to do but I'm getting a "Type mismatch" error at the "For Each item In Folder.Items.Restrict("[unread] = true")" line (within the GetNextLevel Function). Any ideas why this might be?

 

[allockse]

This code looks really useful for something I am trying to do but I'm getting a "Type mismatch" error at the "For Each item In Folder.Items.Restrict("[unread] = true")" line (within the GetNextLevel Function). Any ideas why this might be?

What type is your 'item' object at runtime?