Outlook - VBA to Mark as Read After Sending

[delaing]

Trying to get this to mark the copy of the Sent message (as Read) while copying to a folder.
We are on an exchange server and I use a sub-folder structure contained in a couple of different PST data files; here is an image of the setup.

email folder structure.png

Since I cannot find any other VBA procedures that seem to mark a folder's content as-Read without iterating across each item, I thought I would switch from using Rules to make a copy of the sent message to using VBA. Need to make the copy (after Sending), to a designated folder based on the email address, and mark it as-Read. This is what I've cobbled together so far.

Code: Select all

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
    Dim olCopy As MailItem
    Dim olFolder As Folder

    If TypeName(Item) = "MailItem" Then
        Select Case Item.To
            Case Is = "litigationinfo@somewhere.com"
                Set olFolder = Session.Folders("1 - Delain's Primary email").Folders("HMA - Hugh")
                'add cases and appropriate folder names for each recipient email address to be processed
            Case Is = "hugh@somewhere.com"
                Set olFolder = Session.Folders("1 - Delain's Primary email").Folders("HMA - Hugh")
            Case Is = "craig@somewhere.com"
                Set olFolder = Session.Folders("1 - Delain's Primary email").Folders("HMA - Craig")
                'add cases and appropriate folder and sub folder names for each recipient email address to be processed
            Case Else: Set olFolder = Nothing
        End Select

        If Not olFolder Is Nothing Then
            Set olCopy = Item.Copy
            olCopy.UnRead = False
            olCopy.Move olFolder
        End If

    End If

lbl_Exit:
    Set olCopy = Nothing
    Exit Sub
End Sub

This seems to work, sorta, but it appears to be copying the message - in an Unsent condition - to the folder while sending the original as usual. A message does get sent, but the copy is also an Unsent version of the message.
What might I need to change?

Thanks in advance,
Delain

[HansV]

I'm not sure I understand. The original message is sent, the copy is placed in another folder. Surely you don't want to send the copy too?

[delaing]

No, the result of this code seems to be putting a copy of the unsent message to the folder. That's why I tried to be very deliberate with my statement "Trying to get this to mark the copy of the Sent message (as Read) while copying to a folder."

Delain

[HansV]

If you would like to MOVE the sent item, you could change

Code: Select all

        If Not olFolder Is Nothing Then
            Set olCopy = Item.Copy
            olCopy.UnRead = False
            olCopy.Move olFolder
        End If

to

Code: Select all

        If Not olFolder Is Nothing Then
            Set Item.SaveSentFolder = olFolder
        End If

The sent message will be placed in the specified folder, read and with the correct Sent On date.
I don't know how to do this with a copy of the sent message in this event.

An alternative would be to run a macro periodically that loops through the Sent Items folder...

[delaing]

Thank you.
I will definitely try your suggestion.
Know of a procedure to loop through specific folders, such as shown in my setup, and have those folders cleared or marked as-Read? So they don't show the unread item counter.
That way I could simply run that routine off of a quick access menu (QAT) link. That's really all I'm looking to do - after sending emails, hit keyboard shortcut associated with QAT (Alt-1) and it triggers a Folder clear action.

Delain

[HansV]

Something like this?

Code: Select all

Sub SetRead()
    Dim olFld As Folder
    Dim olItm As Object
    For Each olFld In Session.Folders("1 - Delain's Primary email").Folders
        If olFld.Name Like "HMA - *" Then
            For Each olItm In olFld.Items
                If TypeName(olItm) = "MailItem" Then
                    olItm.UnRead = True
                End If
            Next olItm
        End If
    Next olFld
End Sub

[delaing]

Seems like that is iterating through each item in each folder, one at a time. That won't work.
Also, it set about 8,500 messages to UnRead. Presuming we would need to change

Code: Select all

olItm.UnRead = True

to

Code: Select all

olItm.UnRead = False

I'm still experimenting with your first suggestion to push it around a bit.
Seems the statement is actually SaveSentMessageFolder.

Thank you,
Delain

[HansV]

Sorry about the True/False mixup.
And yes, it's SaveSentMessageFolder. I shouldn't try to write code without testing it.

See VBA Outlook automatically mark all emails in a folder as read for code to mark all items added to a folder as read.

There is no way to mark all items in a folder as read (using VBA) without looping through them.

[delaing]

Thank you for your time and the reference. I will review and see where it leads.
Seems the mark as-Read process has been a nut cruncher for many folks.

See you back on the Excel side later.

Delain

[delaing]

Thought I was going to be okay on my own.
So, the ref you gave does appear to work.
How do I modify to make it work for more than one folder? As you were trying to do with your For Each . . . Like loop.

Code: Select all

Private WithEvents Items As Outlook.Items

Private Sub Application_Startup()
  Dim olNs As Outlook.NameSpace
  Dim Folder As Outlook.MAPIFolder

  Set olNs = Application.GetNamespace("MAPI")
  'Set Folder = olNs.GetDefaultFolder(olFolderInbox)

  Set Folder = Session.Folders("1 - Delain's Primary email").Folders("HMA - Craig")
  '// change the folder if need here
  'Set Folder = olFolder.Folders("Others")
  Set Items = Folder.Items

End Sub

Private Sub Items_ItemAdd(ByVal Item As Object)
    ''Goes with Application_Startup above here.
    Item.UnRead = False
    Item.Save
End Sub

And how is the Sub Items_ItemAdd being called or triggered?

Thanks in advance,
Delain

[HansV]

The Items_ItemAdd event procedure is called automatically when an item is added (i.e. copied, moved or saved) to the folder specified in the code. It is not run for existing items in that folder.

To add the event procedure to multiple folders, remove the code from ThisOutlookSession, and do the following:

1) Select Insert > Class Module.
Name the class module clsItems.
Copy the following code into this class module:

Code: Select all

Public WithEvents olItms As Outlook.Items

Private Sub olItms_ItemAdd(ByVal Item As Object)
    Item.UnRead = False
    Item.Save
End Sub

2. Copy the following code into the ThisOutlookSession module:

Code: Select all

Private colItms As Collection

Private Sub Application_Startup()
    Dim olFld As Folder
    Set colItms = New Collection
    Dim clsInstance As clsItms
    For Each olFld In Session.Folders("1 - Delain's Primary email").Folders
        If olFld.Name Like "HMA - *" Then
            Set clsInstance = New clsItms
            Set clsInstance.olItms = olFld.Items
            colItms.Add clsInstance
        End If
    Next olFld
End Sub

3. Quit Outlook and answer Yes to the question whether you want to save the modules.
Then start Outlook again, and as a test move or copy an unread item into one of the HMA - … folders.

[delaing]

Since we named the Class Module "clsItems", the sub is wanting to see that so needed to correct spelling in two places; no big deal.
Now, your code will mark any new item that comes into one of the folders even new unread mail that is received as new, correct??

Not quite what we're wanting. I tried moving the ThisOutlookSession procedure to a Standard module, giving it a new name, and simply test running it with F5.
Nothing happened. Existing unread items remained unread.
We're hoping for - New, incoming messages need to remain as unread until they are read. Then, when I reply to that or send a new message, that Sent message is copied to the folder. So, it is outgoing messages that would get marked. Apologies if I got us off track here, but that's how this post started out.

Code: Select all

Private colItms As Collection

Private Sub ClearAsRead()
    Dim olFld As Folder
    Set colItms = New Collection
    Dim clsInstance As clsItems

    For Each olFld In Session.Folders("1 - Delain's Primary email").Folders
        If olFld.Name Like "HMA - *" Then
            Set clsInstance = New clsItems
            Set clsInstance.olItms = olFld.Items
            colItms.Add clsInstance
        End If
    Next olFld
End Sub

The Class procedure is as you have it.
I'm sure I messed something up.

Take a break, do some stretching, walk around a bit, and don't give up.

Thank you,
Delain

[HansV]

I am not sure it is possible to do what you want. You might ask in the Outlook for Developers forum on MSDN. Outlook MVPs are active there.

[delaing]

Hans, thank you for your time with this one; appreciate your investment.

Delain