Go Premium for a chance to win a PS4. Enter to Win

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 59
  • Last Modified:

Alter Code to Mark Email as UNREAD

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
Dreamboat
Asked:
Dreamboat
  • 5
  • 2
  • 2
1 Solution
 
Phillip BurtonCommented:
Item.Unread = True
 
should work, but needs to be followed by
 
Item.Save
0
 
DreamboatAuthor Commented:
Checking!
0
 
DreamboatAuthor Commented:
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
Learn Veeam advantages over legacy backup

Every day, more and more legacy backup customers switch to Veeam. Technologies designed for the client-server era cannot restore any IT service running in the hybrid cloud within seconds. Learn top Veeam advantages over legacy backup and get Veeam for the price of your renewal

 
Phillip BurtonCommented:
Just a guess - Try it in another order:

              Item.UnRead = True
              Item.Save
              Item.Move objAttFld
0
 
DreamboatAuthor Commented:
No. Sorry. I was keeping my fingers crossed, too. :)
0
 
FarWestCommented:
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
 
DreamboatAuthor Commented:
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
 
FarWestCommented:
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
 
DreamboatAuthor Commented:
I'm sorry. I didn't notice the post until now. Will try tomorrow at work. Thanks so much!
0

Featured Post

[Webinar] Cloud and Mobile-First Strategy

Maybe you’ve fully adopted the cloud since the beginning. Or maybe you started with on-prem resources but are pursuing a “cloud and mobile first” strategy. Getting to that end state has its challenges. Discover how to build out a 100% cloud and mobile IT strategy in this webinar.

  • 5
  • 2
  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now