PDA

View Full Version : Move sent emails and mark as read



synlupri
05-13-2015, 02:59 PM
Just learning and admittedly am as NOOB as they come.

I've turned off auto save sent items in Outlook 07, set rule to move sent emails marked "private" to a folder called "PRIVATE_SENT".
I also set a rule to save emails not marked "private" to a new subfolder called "_Sent_Items".
I did this per directions I found.
However, it leaves everything in both folders as "unread".

My dilemma is every search for mark moved items as "read" that I've done today, gives examples of a macro for this IF they are Inbox subfolders.

Neither of these are subfolders of Inbox.
PRIVATE_SENT is a subfolder of a folder called "_PRIVATE" which is at the root.
_SENT_ITEMS is a folder at the root.

I found this code, which if someone can help me figure out how to change it to subfolders not located under Inbox, I can probably make it work.
I've tried changing "Jane" to "PRIVATE_SENT", and "Flavius" to "_Sent_Items", but that didn't work.
I know I probably sound completely ignorant to you.
Can you please help?
Am I way of base here?
Am I hopeless?:crying:

Listing 1: Monitoring Message Folders for New Items to Mark as Read


Option Explicit
Dim WithEvents colJaneItems As Outlook.Items
Dim WithEvents colFlaviusItems As Outlook.Items

Private Sub Application_Startup()
Dim objNS As Outlook.NameSpace
Dim objSent As Outlook.MAPIFolder
Dim objFolder As Outlook.MAPIFolder

Set objNS = Application.GetNamespace("MAPI")
Set objSent = objNS.GetDefaultFolder(olFolderSentMail)

Set objFolder = objSent.Folders("Jane")
If objFolder Is Nothing Then
Set objFolder = objSent.Folders.Add("Jane")
End If
If Not objFolder Is Nothing Then
Set colJaneItems = objFolder.Items
Set objFolder = Nothing
End If

Set objFolder = objSent.Folders("Flavius")
If objFolder Is Nothing Then
Set objFolder = objSent.Folders.Add("Flavius")
End If
If Not objFolder Is Nothing Then
Set colFlaviusItems = objFolder.Items
Set objFolder = Nothing
End If

Set objNS = Nothing
Set objSent = Nothing
End Sub


Private Sub colJaneItems_ItemAdd(ByVal Item As Object)
Call MarkAsRead(Item)
End Sub


Private Sub colFlaviusItems_ItemAdd(ByVal Item As Object)
Call MarkAsRead(Item)
End Sub


Sub MarkAsRead(objItem As Object)
objItem.UnRead = False
objItem.Save
End Sub

gmayor
05-13-2015, 11:19 PM
If the folder you are looking for is off the root then ....



Dim olNS As NameSpace
Dim oFolder As Folder
Dim oSubFolder As Folder
Dim oSubFolder1 As Folder

Set olNS = Application.GetNamespace("Mapi") 'Root
Set oFolder = olNS.GetDefaultFolder(olFolderInbox).Parent
Set oSubFolder = oFolder.folders("_PRIVATE") 'Folder off the root
Set oSubFolder1 = oSubFolder.folders("PRIVATE_SENT") 'Sub folder of "_PRIVATE"