Consulting

Results 1 to 2 of 2

Thread: Move sent emails and mark as read

  1. #1
    VBAX Newbie
    Joined
    May 2015
    Posts
    1
    Location

    Unhappy Move sent emails and mark as read

    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?

    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

  2. #2
    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"
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •