?
Solved

Alter Code to Mark Email as UNREAD

Posted on 2015-02-24
9
Medium Priority
?
57 Views
Last Modified: 2016-02-11
I got the following code from outlookcode.com. It works great except that the item that is moved into the Voicemail folder is marked as read and I don't want that. I don't see where the code is doing that. I added the line that marks it as unread, but it doesn't work whether I use:

              Item.Read = False

or

              Item.Unread = True

Private Sub olInboxItems_ItemAdd(ByVal Item As Object)
  Dim objAttFld As MAPIFolder
  Dim objInbox As MAPIFolder
  Dim objNS As NameSpace
  Dim strAttFldName As String
  Dim strProgExt As String
  Dim arrExt() As String
  Dim objAtt As Attachment
  Dim intPos As Integer
  Dim I As Integer
  Dim strExt As String

  ' #### USER OPTIONS ####
  ' name of Inbox subfolder containing messages with attachments
  strAttFldName = "Voicemail"
  ' delimited list of extensions to trap
  strProgExt = "wav"

  On Error Resume Next
  Set objNS = Application.GetNamespace("MAPI")
  Set objInbox = objNS.GetDefaultFolder(olFolderInbox)
  Set objAttFld = objInbox.Folders(strAttFldName)
  If Item.Class = olMail Then
    If objAttFld Is Nothing Then
      ' create folder if needed
      Set objAttFld = objInbox.Folders.Add(strAttFldName)
    End If
    If Not objAttFld Is Nothing Then
      ' convert delimited list of extensions to array
      arrExt = Split(strProgExt, ",")
      For Each objAtt In Item.Attachments
        intPos = InStrRev(objAtt.FileName, ".")
        If intPos > 0 Then
          ' check attachment extension against array
          strExt = LCase(Mid(objAtt.FileName, intPos + 1))
          For I = LBound(arrExt) To UBound(arrExt)
            If strExt = Trim(arrExt(I)) Then
              Item.Move objAttFld
              Item.Read = False
              Exit For
            End If
          Next
        Else
          ' no extension; unknown type
          Item.Move objAttFld
        End If
      Next
    End If
  End If

  On Error GoTo 0
  Set objAttFld = Nothing
  Set objInbox = Nothing
  Set objNS = Nothing
  Set objAtt = Nothing
End Sub

Open in new window

0
Comment
Question by:Dreamboat
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 5
  • 2
  • 2
9 Comments
 
LVL 24

Expert Comment

by:Phillip Burton
ID: 40627855
Item.Unread = True
 
should work, but needs to be followed by
 
Item.Save
0
 
LVL 22

Author Comment

by:Dreamboat
ID: 40627856
Checking!
0
 
LVL 22

Author Comment

by:Dreamboat
ID: 40627857
Arghh. That changed nothing. I am using Outlook 2007--forgot to mention. Also, after altering the code, I shutdown Outlook, reopen and test.

Private Sub olInboxItems_ItemAdd(ByVal Item As Object)
  Dim objAttFld As MAPIFolder
  Dim objInbox As MAPIFolder
  Dim objNS As NameSpace
  Dim strAttFldName As String
  Dim strProgExt As String
  Dim arrExt() As String
  Dim objAtt As Attachment
  Dim intPos As Integer
  Dim I As Integer
  Dim strExt As String

  ' #### USER OPTIONS ####
  ' name of Inbox subfolder containing messages with attachments
  strAttFldName = "Voicemail"
  ' delimited list of extensions to trap
  strProgExt = "wav"

  On Error Resume Next
  Set objNS = Application.GetNamespace("MAPI")
  Set objInbox = objNS.GetDefaultFolder(olFolderInbox)
  Set objAttFld = objInbox.Folders(strAttFldName)
  If Item.Class = olMail Then
    If objAttFld Is Nothing Then
      ' create folder if needed
      Set objAttFld = objInbox.Folders.Add(strAttFldName)
    End If
    If Not objAttFld Is Nothing Then
      ' convert delimited list of extensions to array
      arrExt = Split(strProgExt, ",")
      For Each objAtt In Item.Attachments
        intPos = InStrRev(objAtt.FileName, ".")
        If intPos > 0 Then
          ' check attachment extension against array
          strExt = LCase(Mid(objAtt.FileName, intPos + 1))
          For I = LBound(arrExt) To UBound(arrExt)
            If strExt = Trim(arrExt(I)) Then
              Item.Move objAttFld
              Item.UnRead = True
              Item.Save
              Exit For
            End If
          Next
        Else
          ' no extension; unknown type
          Item.Move objAttFld
        End If
      Next
    End If
  End If

  On Error GoTo 0
  Set objAttFld = Nothing
  Set objInbox = Nothing
  Set objNS = Nothing
  Set objAtt = Nothing
End Sub

Open in new window

0
Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
LVL 24

Expert Comment

by:Phillip Burton
ID: 40627861
Just a guess - Try it in another order:

              Item.UnRead = True
              Item.Save
              Item.Move objAttFld
0
 
LVL 22

Author Comment

by:Dreamboat
ID: 40627867
No. Sorry. I was keeping my fingers crossed, too. :)
0
 
LVL 12

Expert Comment

by:FarWest
ID: 40627883
Since you are using subfolders in Inbox folder to organize emails
 I recommended using categories to organize inbox. This way new messages will be noticed without going to subfolder or using search folders. And you can have multiple categories for the same message if you need
This way I hope you will not face the unread problem :)
0
 
LVL 22

Author Comment

by:Dreamboat
ID: 40627902
They are voicemails. I simply don't want to miss them. Once I listen to it, I will delete it. Categories seems like overkill?
0
 
LVL 12

Accepted Solution

by:
FarWest earned 2000 total points
ID: 40628185
I meant the VBA code will not move email and only categorize it, and when you have category column in Inbox you can see and pay attention to those emails, anyway I've seen in some samples  (not Guessing or crossing fingers) the unread is changed before moving the Item not after so I wish you try  it

             Item.UnRead = True
             Item.Move objAttFld
0
 
LVL 22

Author Comment

by:Dreamboat
ID: 40631860
I'm sorry. I didn't notice the post until now. Will try tomorrow at work. Thanks so much!
0

Featured Post

Veeam Disaster Recovery in Microsoft Azure

Veeam PN for Microsoft Azure is a FREE solution designed to simplify and automate the setup of a DR site in Microsoft Azure using lightweight software-defined networking. It reduces the complexity of VPN deployments and is designed for businesses of ALL sizes.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

This article lists the top 5 free OST to PST Converter Tools. These tools save a lot of time for users when they want to convert OST to PST after their exchange server is no longer available or some other critical issue with exchange server or impor…
This article will help to fix the below errors for MS Exchange Server 2013 I. Certificate error "name on the security certificate is invalid or does not match the name of the site" II. Out of Office not working III. Make Internal URLs and Externa…
Many of my clients call in with monstrous Gmail overloading issues with Outlook. A quick tip is to turn off the All Mail and Important folders from synching. Here is a quick video I made to show you how to turn off these and other folders in Gmail s…
A short tutorial showing how to set up an email signature in Outlook on the Web (previously known as OWA). For free email signatures designs, visit https://www.mail-signatures.com/articles/signature-templates/?sts=6651 If you want to manage em…
Suggested Courses

765 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question