Solved

Alter Code to Mark Email as UNREAD

Posted on 2015-02-24
9
52 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
  • 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
Microsoft Certification Exam 74-409

Veeam® is happy to provide the Microsoft community with a study guide prepared by MVP and MCT, Orin Thomas. This guide will take you through each of the exam objectives, helping you to prepare for and pass the examination.

 
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 500 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

Efficient way to get backups off site to Azure

This user guide provides instructions on how to deploy and configure both a StoneFly Scale Out NAS Enterprise Cloud Drive virtual machine and Veeam Cloud Connect in the Microsoft Azure Cloud.

Question has a verified solution.

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

Some code to ensure data integrity when using macros within Excel. Also included code that helps secure your data within an Excel workbook.
When you see single cell contains number and text, and you have to get any date out of it seems like cracking our heads.
To add imagery to an HTML email signature, you have two options available to you. You can either add a logo/image by embedding it directly into the signature or hosting it externally and linking to it. The vast majority of email clients display l…
Although Jacob Bernoulli (1654-1705) has been credited as the creator of "Binomial Distribution Table", Gottfried Leibniz (1646-1716) did his dissertation on the subject in 1666; Leibniz you may recall is the co-inventor of "Calculus" and beat Isaac…

777 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